Theory Generated_Subalgebra

(*  Title:      Restricted_Measure_Space.thy
    Author:     Mnacho Echenim, Univ. Grenoble Alpes
*)

section ‹Generated subalgebras›

text ‹This section contains definitions and properties related to generated subalgebras.›

theory Generated_Subalgebra imports "HOL-Probability.Probability"

begin



definition gen_subalgebra where
"gen_subalgebra M G = sigma (space M) G"


lemma gen_subalgebra_space:
  shows "space (gen_subalgebra M G) = space M"
by (simp add: gen_subalgebra_def space_measure_of_conv)


lemma gen_subalgebra_sets:
  assumes "G  sets M"
  and "A  G"
  shows "A  sets (gen_subalgebra M G)"
by (metis assms gen_subalgebra_def sets.space_closed sets_measure_of sigma_sets.Basic subset_trans)


lemma gen_subalgebra_sig_sets:
  assumes "G  Pow (space M)"
  shows "sets (gen_subalgebra M G) = sigma_sets (space M) G" unfolding gen_subalgebra_def
by (metis assms gen_subalgebra_def sets_measure_of)

lemma  gen_subalgebra_sigma_sets:
  assumes "G  sets M"
  and "sigma_algebra (space M) G"
  shows "sets (gen_subalgebra M G) = G"
using assms by (simp add: gen_subalgebra_def sigma_algebra.sets_measure_of_eq)


lemma gen_subalgebra_is_subalgebra:
  assumes sub: "G  sets M"
  and sigal:"sigma_algebra (space M) G"
  shows "subalgebra M (gen_subalgebra M G)" (is "subalgebra M ?N")
unfolding subalgebra_def
proof (intro conjI)
  show "space ?N = space M" using space_measure_of_conv[of "(space M)"]  unfolding gen_subalgebra_def by simp
  have geqn: "G = sets ?N" using assms by (simp add:gen_subalgebra_sigma_sets)
  thus "sets ?N  sets M" using assms by simp
qed


definition  fct_gen_subalgebra :: "'a measure  'b measure  ('a  'b)  'a measure" where
  "fct_gen_subalgebra M N X = gen_subalgebra M (sigma_sets (space M) {X -` B  (space M) | B. B  sets N})"



lemma fct_gen_subalgebra_sets:
  shows "sets (fct_gen_subalgebra M N X) = sigma_sets (space M) {X -` B  space M |B. B  sets N}"
unfolding fct_gen_subalgebra_def gen_subalgebra_def
proof -
  have "{X -` B  space M |B. B  sets N}  Pow (space M)"
    by blast
  then show "sets (sigma (space M) (sigma_sets (space M) {X -` B  space M |B. B  sets N})) = sigma_sets (space M) {X -` B  space M |B. B  sets N}"
    by (meson sigma_algebra.sets_measure_of_eq sigma_algebra_sigma_sets)
qed

lemma fct_gen_subalgebra_space:
  shows "space (fct_gen_subalgebra M N X) = space M"
  unfolding fct_gen_subalgebra_def by (simp add: gen_subalgebra_space)

lemma fct_gen_subalgebra_eq_sets:
  assumes "sets M = sets P"
  shows "fct_gen_subalgebra M N X = fct_gen_subalgebra P N X"
proof -
  have "space M = space P" using sets_eq_imp_space_eq assms by auto
  thus ?thesis unfolding fct_gen_subalgebra_def gen_subalgebra_def by simp
qed

lemma fct_gen_subalgebra_sets_mem:
  assumes "B sets N"
  shows "X -` B  (space M)  sets (fct_gen_subalgebra M N X)" unfolding fct_gen_subalgebra_def
proof -
  have f1: "{X -` A  space M |A. A  sets N}  Pow (space M)"
    by blast
  have "A. X -` B  space M = X -` A  space M  A  sets N"
    by (metis assms)
  then show "X -` B  space M  sets (gen_subalgebra M (sigma_sets (space M) {X -` A  space M |A. A  sets N}))"
    using f1 by (simp add: gen_subalgebra_def sigma_algebra.sets_measure_of_eq sigma_algebra_sigma_sets)
qed

lemma fct_gen_subalgebra_is_subalgebra:
  assumes "X measurable M N"
  shows "subalgebra M (fct_gen_subalgebra M N X)"
unfolding fct_gen_subalgebra_def
proof (rule gen_subalgebra_is_subalgebra)
  show "sigma_sets (space M) {X -` B  space M |B. B  sets N}  sets M" (is "?L  ?R")
  proof (rule sigma_algebra.sigma_sets_subset)
    show "{X -` B  space M |B. B  sets N}  sets M"
    proof
      fix a
      assume "a  {X -` B  (space M) | B. B  sets N}"
      then obtain B where "B  sets N" and "a = X -` B  (space M)" by auto
      thus "a  sets M" using measurable_sets assms by simp
    qed
    show "sigma_algebra (space M) (sets M)" using measure_space by (auto simp add: measure_space_def)
  qed
  show "sigma_algebra (space M) ?L"
  proof (rule sigma_algebra_sigma_sets)
    let ?preimages = "{X -` B  (space M) | B. B  sets N}"
    show "?preimages  Pow (space M)" using assms by auto
  qed
qed

lemma fct_gen_subalgebra_fct_measurable:
  assumes "X  space M  space N"
  shows "X measurable (fct_gen_subalgebra M N X) N"
unfolding measurable_def
proof ((intro CollectI), (intro conjI))
  have speq: "space M = space (fct_gen_subalgebra M N X)"
      by (simp add: fct_gen_subalgebra_space)
  show "X  space (fct_gen_subalgebra M N X)  space N"
  proof -
    have "X  space M  space N"  using assms by simp
    thus ?thesis using speq by simp
  qed
  show "ysets N.
       X -` y  space (fct_gen_subalgebra M N X)  sets (fct_gen_subalgebra M N X)"
  using  fct_gen_subalgebra_sets_mem speq by metis
qed




lemma fct_gen_subalgebra_min:
  assumes "subalgebra M P"
  and "f measurable P N"
  shows "subalgebra P (fct_gen_subalgebra M N f)"
unfolding subalgebra_def
proof (intro conjI)
  let ?Mf = "fct_gen_subalgebra M N f"
  show "space ?Mf = space P" using assms
    by (simp add: fct_gen_subalgebra_def gen_subalgebra_space subalgebra_def)
  show inc: "sets ?Mf  sets P"
  proof -
    have "space M = space P" using assms by (simp add:subalgebra_def)
    have "f measurable M N" using assms using measurable_from_subalg by blast
    have "sigma_algebra (space P) (sets P)" using assms measure_space measure_space_def by auto
    have " A  sets N. f-`A  space P  sets P" using assms by simp
    hence "{f -` A  (space M) | A. A  sets N}  sets P" using ‹space M = space P by auto
    hence "sigma_sets (space M) {f -` A  (space M) | A. A  sets N}  sets P"
      by (simp add: ‹sigma_algebra (space P) (sets P) ‹space M = space P sigma_algebra.sigma_sets_subset)
    thus ?thesis using fct_gen_subalgebra_sets f  M M N ‹space M = space P assms(2)
      measurable_sets mem_Collect_eq sets.sigma_sets_subset subsetI by blast
  qed
qed

lemma fct_preimage_sigma_sets:
  assumes "X space M  space N"
  shows "sigma_sets (space M) {X -` B  space M |B. B  sets N} = {X -` B  space M |B. B  sets N}" (is "?L = ?R")
proof
  show "?R ?L" by blast
  show "?L ?R"
  proof
    fix A
    assume "A ?L"
    thus "A ?R"
    proof (induct rule:sigma_sets.induct, auto)
      {
        fix B
        assume "B sets N"
        let ?cB = "space N - B"
        have "?cB  sets N" by (simp add: B  sets N sets.compl_sets)
        have "space M - X -` B  space M = X -` ?cB  space M"
        proof
          show "space M - X -` B  space M  X -` (space N - B)  space M"
          proof
            fix w
            assume "w  space M - X -` B  space M"
            hence "X w  (space N - B)" using assms by blast
            thus "w X -` (space N - B)  space M" using w  space M - X -` B  space M by blast
          qed
          show "X -` (space N - B)  space M  space M - X -` B  space M"
          proof
            fix w
            assume "w X -` (space N - B)  space M"
            thus "w  space M - X -` B  space M" by blast
          qed
        qed
        thus "Ba. space M - X -` B  space M = X -` Ba  space M  Ba  sets N" using ?cB  sets N by auto
      }
      {
        fix S::"nat  'a set"
        assume "(i. B. S i = X -` B  space M  B  sets N)"
        hence "(i. B. S i = X -` B  space M  B  sets N)" by auto
        hence " f.  x. S x = X -`(f x)  space M  (f x)  sets N"
          using choice[of "λi B . S i = X -` B  space M  B  sets N"] by simp
        from this obtain rep where "i. S i = X -` (rep i)  space M  (rep i)  sets N" by auto note rProp = this
        let ?uB = "i UNIV. rep i"
        have "?uB  sets N"
          by (simp add: i. S i = X -` rep i  space M  rep i  sets N countable_Un_Int(1))
        have "(x. S x) = X -` ?uB  space M"
        proof
          show "(x. S x)  X -` (i. rep i)  space M"
          proof
            fix w
            assume "w (x. S x)"
            hence "x. w  S x" by auto
            from this obtain x where "w  S x" by auto
            hence "w  X -` rep x  space M" using rProp by simp
            hence "w (i. (X -`(rep i) space M))" by blast
            also have "... = X -` (i. rep i)  space M" by auto
            finally show "w  X -` (i. rep i)  space M" .
          qed
          show "X -` (i. rep i)  space M  (x. S x)"
          proof
            fix w
            assume "w X -` (i. rep i)  space M"
            hence " x. w X -` (rep x)  space M" by auto
            from this obtain x where "w X -` (rep x)  space M" by auto
            hence "w S x" using rProp by simp
            thus "w (x. S x)" by blast
          qed
        qed
        thus "B. (x. S x) = X -` B  space M  B  sets N" using ?uB  sets N by auto
      }
    qed
  qed
qed

lemma fct_gen_subalgebra_sigma_sets:
  assumes "X space M  space N"
  shows "sets (fct_gen_subalgebra M N X) = {X -` B  space M |B. B  sets N}"
  by (simp add: assms fct_gen_subalgebra_sets fct_preimage_sigma_sets)


lemma fct_gen_subalgebra_info:
  assumes "f space M  space N"
  and "x space M"
  and "w space M"
  and "f x = f w"
  shows "A. A sets (fct_gen_subalgebra M N f)  (x A) = (w A)"
proof -
  {fix A
  assume "A  sigma_sets (space M)  {f -` B  (space M) | B. B  sets N}"
  from this have  "(x A) = (w A)"
  proof (induct rule:sigma_sets.induct)
    {
      fix a
      assume "a  {f -` B  space M |B. B  sets N}"
      hence " B sets N. a = f -` B  space M" by auto
      from this obtain B where "B sets N" and "a = f -` B  space M" by blast note bhyps = this
      show "(x a) = (w a)" by (simp add: assms(2) assms(3) assms(4) bhyps(2))
    }
    {
      fix a
      assume "a  sigma_sets (space M) {f -` B  space M |B. B  sets N}"
      and "(x  a) = (w  a)" note xh = this
      show "(x  space M - a) = (w  space M - a)" by (simp add: assms(2) assms(3) xh(2))
    }
    {
      fix a::"nat  'a set"
      assume "(i. a i  sigma_sets (space M) {f -` B  space M |B. B  sets N})"
      and "(i. (x  a i) = (w  a i))"
      show "(x  (a ` UNIV)) = (w  (a ` UNIV))" by (simp add: i. (x  a i) = (w  a i))
    }
    {show "(x {}) = (w {})" by simp}
  qed} note eqsig = this
  fix A
  assume "A sets (fct_gen_subalgebra M N f)"
  hence "A  sigma_sets (space M)  {f -` B  (space M) | B. B  sets N}"
    using assms(1) fct_gen_subalgebra_sets by blast
  thus "(x A) = (w A)" using eqsig by simp
qed

subsection ‹Independence between a random variable and a subalgebra.›

definition (in prob_space) subalgebra_indep_var :: "('a  real)  'a measure  bool" where
  "subalgebra_indep_var X N 
    X borel_measurable M &
    (subalgebra M N) &
    (indep_set (sigma_sets (space M) { X -` A  space M | A. A  sets borel}) (sets N))"


lemma (in prob_space) indep_set_mono:
  assumes "indep_set A B"
  assumes "A'  A"
  assumes "B'  B"
  shows "indep_set A' B'"
by (meson indep_sets2_eq assms subsetCE subset_trans)


lemma (in prob_space) subalgebra_indep_var_indicator:
  fixes X::"'areal"
  assumes "subalgebra_indep_var X N"
  and "X  borel_measurable M"
  and "A  sets N"
  shows "indep_var borel X borel (indicator A)"
proof ((rule indep_var_eq[THEN iffD2]), (intro conjI))
  let ?IA = "(indicator A)::'a real"
  show bm:"random_variable borel X" by (simp add: assms(2))
  show "random_variable borel ?IA" using assms indep_setD_ev2 unfolding subalgebra_indep_var_def by auto
  show "indep_set (sigma_sets (space M) {X -` A  space M |A. A  sets borel})
   (sigma_sets (space M) {?IA -` Aa  space M |Aa. Aa  sets borel})"
  proof (rule indep_set_mono)
    show "sigma_sets (space M) {X -` A  space M |A. A  sets borel}  sigma_sets (space M) {X -` A  space M |A. A  sets borel}" by simp
    show "sigma_sets (space M) {?IA -` B  space M |B. B  sets borel}  sets N"
    proof -
      have "sigma_algebra (space M) (sets N)" using assms
        by (metis subalgebra_indep_var_def sets.sigma_algebra_axioms subalgebra_def)
      have "sigma_sets (space M) {?IA -` B  space M |B. B  sets borel}  sigma_sets (space M) (sets N)"
      proof (rule sigma_sets_subseteq)
        show "{?IA -` B  space M |B. B  sets borel}  sets N"
        proof
          fix x
          assume "x  {?IA -` B  space M |B. B  sets borel}"
          then obtain B where "B  sets borel" and "x = ?IA -` B  space M" by auto
          thus "x  sets N"
            by (metis (no_types, lifting) assms(1) assms(3) borel_measurable_indicator measurable_sets subalgebra_indep_var_def subalgebra_def)
        qed
      qed
      also have "... = sets N"
        by (simp add: ‹sigma_algebra (space M) (sets N) sigma_algebra.sigma_sets_eq)
      finally show "sigma_sets (space M) {?IA -` B  space M |B. B  sets borel}  sets N" .
    qed
    show "indep_set (sigma_sets (space M) {X -` A  space M |A. A  sets borel}) (sets N) "
      using assms unfolding subalgebra_indep_var_def by simp
  qed
qed

lemma fct_gen_subalgebra_cong:
  assumes "space M = space P"
  and "sets N = sets Q"
  shows "fct_gen_subalgebra M N X = fct_gen_subalgebra P Q X"
proof -
  have "space M = space P" using assms by simp
  thus ?thesis using assms unfolding fct_gen_subalgebra_def gen_subalgebra_def by simp
qed



end

Theory Filtration

(*  Title:      Filtration.thy
    Author:     Mnacho Echenim, Univ. Grenoble Alpes
*)

section ‹Filtrations›

text ‹This theory introduces basic notions about filtrations, which permit to define adaptable processes
and predictable processes in the case where the filtration is indexed by natural numbers.›

theory Filtration imports "HOL-Probability.Probability"
begin
subsection ‹Basic definitions›
class linorder_bot = linorder + bot
instantiation nat::linorder_bot
begin
instance proof qed
end


definition filtration :: "'a measure  ('i::linorder_bot  'a measure)  bool" where
  "filtration M F 
    (t. subalgebra M (F t))  
    ( s t. s  t  subalgebra (F t) (F s))"

lemma filtrationI:
  assumes "t. subalgebra M (F t)"
  and "s t. s  t  subalgebra (F t) (F s)"
shows "filtration M F" unfolding filtration_def using assms by simp

lemma filtrationE1:
  assumes "filtration M F"
  shows "subalgebra M (F t)" using assms unfolding filtration_def by simp

lemma filtrationE2:
  assumes "filtration M F"
  shows "s t  subalgebra (F t) (F s)" using assms unfolding filtration_def by simp

locale filtrated_prob_space = prob_space +
  fixes F
  assumes filtration: "filtration M F"

lemma (in filtrated_prob_space) filtration_space:
  assumes "s  t"
  shows "space (F s) = space (F t)" by (metis filtration filtration_def subalgebra_def)

lemma (in filtrated_prob_space) filtration_measurable:
  assumes "f measurable (F t) N"
shows "f measurable M N" unfolding measurable_def
proof
  show "f  space M  space N  (ysets N. f -` y  space M  sets M)"
  proof (intro conjI ballI)
    have "space (F t) = space M" using assms filtration unfolding filtration_def subalgebra_def by auto
    thus "f space M  space N" using assms unfolding measurable_def by simp
    fix y
    assume "y sets N"
    hence "f -`y space M  sets (F t)" using assms unfolding measurable_def
      using ‹space (F t) = space M by auto
    thus "f -`y space M  sets M"  using assms filtration unfolding filtration_def subalgebra_def by auto
  qed
qed


lemma (in filtrated_prob_space) increasing_measurable_info:
  assumes "f measurable (F s) N"
  and "s  t"
  shows "f measurable (F t) N"
proof (rule measurableI)
  have inc: "sets (F s)  sets (F t)"
    using assms(2) filtration by (simp add: filtration_def subalgebra_def)
  have sp: "space (F s) = space (F t)" by (metis filtration filtration_def subalgebra_def)
  thus "x. x  space (F t)  f x  space N" using assms by (simp add: measurable_space)
  show "A. A  sets N  f -` A  space (F t)  sets (F t)"
  proof -
    fix A
    assume "A sets N"
    hence "f -` A  space (F s)  sets (F s)" using assms using measurable_sets by blast
    hence "f -` A  space (F s)  sets (F t)" using subsetD[of "F s" "F t"] inc by blast
    thus "f -` A  space (F t)  sets (F t)" using sp by simp
  qed
qed



definition disc_filtr :: "'a measure  (nat  'a measure)  bool" where
  "disc_filtr M F 
    (n. subalgebra M (F n))  
    ( n m. n  m  subalgebra (F m) (F n))"


locale disc_filtr_prob_space = prob_space +
  fixes F
  assumes discrete_filtration: "disc_filtr M F"

lemma (in disc_filtr_prob_space) subalgebra_filtration:
  assumes "subalgebra N M"
  and "filtration M F"
shows "filtration N F"
proof (rule filtrationI)
  show "s t. s  t  subalgebra (F t) (F s)" using assms unfolding filtration_def by simp
  show "t. subalgebra N (F t)"
  proof
    fix t
    have "subalgebra M (F t)" using assms unfolding filtration_def by auto
    thus "subalgebra N (F t)" using assms by (metis subalgebra_def subsetCE subsetI)
  qed
qed



sublocale disc_filtr_prob_space   filtrated_prob_space
proof unfold_locales
  show "filtration M F"
    using  discrete_filtration by (simp add: filtration_def disc_filtr_def)
qed



subsection ‹Stochastic processes›

text  ‹Stochastic processes are collections of measurable functions. Those of a particular interest when
there is a filtration are the adapted stochastic processes.›

definition stoch_procs where
  "stoch_procs M N = {X. t. (X t)  measurable M N}"

subsubsection ‹Adapted stochastic processes›

definition adapt_stoch_proc where
  "(adapt_stoch_proc F X N)  (t. (X t)  measurable (F t) N)"


abbreviation "borel_adapt_stoch_proc F X  adapt_stoch_proc F X borel"

lemma (in filtrated_prob_space) adapted_is_dsp:
  assumes "adapt_stoch_proc F X N"
  shows "X  stoch_procs M N"
  unfolding  stoch_procs_def
  by (intro CollectI, (meson adapt_stoch_proc_def assms filtration filtration_def measurable_from_subalg))


lemma (in filtrated_prob_space) adapt_stoch_proc_borel_measurable:
  assumes "adapt_stoch_proc F X N"
  shows "n. (X n)  measurable M N"
proof
  fix n
  have "X n  measurable (F n) N" using assms unfolding  adapt_stoch_proc_def by simp
  moreover have "subalgebra M (F n)" using filtration unfolding filtration_def by simp
  ultimately show "X n  measurable M N" by (simp add:measurable_from_subalg)
qed

lemma (in filtrated_prob_space) borel_adapt_stoch_proc_borel_measurable:
  assumes "borel_adapt_stoch_proc F X"
  shows "n. (X n)  borel_measurable M"
proof
  fix n
  have "X n  borel_measurable (F n)" using assms unfolding  adapt_stoch_proc_def by simp
  moreover have "subalgebra M (F n)" using filtration unfolding filtration_def by simp
  ultimately show "X n  borel_measurable M" by (simp add:measurable_from_subalg)
qed


lemma (in filtrated_prob_space) constant_process_borel_adapted:
  shows "borel_adapt_stoch_proc F (λ n w. c)"
unfolding  adapt_stoch_proc_def
proof
  fix t
  show "(λw. c)  borel_measurable (F t)" using borel_measurable_const by blast
qed


lemma (in filtrated_prob_space) borel_adapt_stoch_proc_add:
  fixes X::"'b  'a  ('c::{second_countable_topology, topological_monoid_add})"
  assumes "borel_adapt_stoch_proc F X"
  and "borel_adapt_stoch_proc F Y"
shows "borel_adapt_stoch_proc F (λt w. X t w + Y t w)" unfolding adapt_stoch_proc_def
proof
  fix t
  have "X t  borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
  moreover have "Y t  borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
  ultimately show "(λw. X t w + Y t w)  borel_measurable (F t)" by simp
qed


lemma (in filtrated_prob_space) borel_adapt_stoch_proc_sum:
  fixes A::"'d  'b  'a  ('c::{second_countable_topology, topological_comm_monoid_add})"
  assumes "i. i S  borel_adapt_stoch_proc F (A i)"
shows "borel_adapt_stoch_proc F (λ t w. ( i S. A i t w))" unfolding adapt_stoch_proc_def
proof
  fix t
  have "i. i S A i t  borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
  thus "(λ w. ( i S. A i t w))  borel_measurable (F t)" by (simp add:borel_measurable_sum)
qed

lemma (in filtrated_prob_space) borel_adapt_stoch_proc_times:
  fixes X::"'b  'a  ('c::{second_countable_topology, real_normed_algebra})"
  assumes "borel_adapt_stoch_proc F X"
  and "borel_adapt_stoch_proc F Y"
shows "borel_adapt_stoch_proc F (λt w. X t w * Y t w)" unfolding adapt_stoch_proc_def
proof
  fix t
  have "X t  borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
  moreover have "Y t  borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
  ultimately show "(λw. X t w * Y t w)  borel_measurable (F t)" by simp
qed

lemma (in filtrated_prob_space) borel_adapt_stoch_proc_prod:
  fixes A::"'d  'b  'a  ('c::{second_countable_topology, real_normed_field})"
  assumes "i. i S  borel_adapt_stoch_proc F (A i)"
shows "borel_adapt_stoch_proc F (λ t w. ( i S. A i t w))" unfolding adapt_stoch_proc_def
proof
  fix t
  have "i. i S A i t  borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
  thus "(λ w. ( i S. A i t w))  borel_measurable (F t)" by simp
qed


subsubsection ‹Predictable stochastic processes›

definition predict_stoch_proc where
  "(predict_stoch_proc F X N)  (X 0  measurable (F 0) N  (n. (X (Suc n))  measurable (F n) N))"


abbreviation  "borel_predict_stoch_proc F X  predict_stoch_proc F X borel"

lemma (in disc_filtr_prob_space) predict_imp_adapt:
  assumes "predict_stoch_proc F X N"
  shows "adapt_stoch_proc F X N" unfolding adapt_stoch_proc_def
proof
  fix n
  show "X n  measurable (F n) N"
  proof (cases "n = 0")
    case True
    thus ?thesis using assms unfolding predict_stoch_proc_def by auto
  next
    case False
    thus ?thesis using assms unfolding predict_stoch_proc_def
      by (metis Suc_n_not_le_n increasing_measurable_info nat_le_linear not0_implies_Suc)
  qed
qed


lemma (in disc_filtr_prob_space) predictable_is_dsp:
  assumes "predict_stoch_proc F X N"
  shows "X  stoch_procs M N"
unfolding  stoch_procs_def
proof
  show "n. random_variable N (X n)"
  proof
    fix n
    show "random_variable N (X n)"
    proof (cases "n=0")
      case True
      thus ?thesis using assms unfolding predict_stoch_proc_def
        using filtration filtration_def measurable_from_subalg by blast
    next
      case False
      thus ?thesis using assms unfolding predict_stoch_proc_def
        by (metis filtration filtration_def measurable_from_subalg not0_implies_Suc)
    qed
  qed
qed



lemma (in disc_filtr_prob_space) borel_predict_stoch_proc_borel_measurable:
  assumes "borel_predict_stoch_proc F X"
  shows "n. (X n)  borel_measurable M" using assms predictable_is_dsp unfolding stoch_procs_def by auto



lemma (in disc_filtr_prob_space) constant_process_borel_predictable:
  shows "borel_predict_stoch_proc F (λ n w. c)"
unfolding  predict_stoch_proc_def
proof
  show "(λw. c)  borel_measurable (F 0)" using borel_measurable_const by blast
next
  show "n. (λw. c)  borel_measurable (F n)" using borel_measurable_const by blast
qed

lemma (in disc_filtr_prob_space) borel_predict_stoch_proc_add:
  fixes X::"nat  'a  ('c::{second_countable_topology, topological_monoid_add})"
  assumes "borel_predict_stoch_proc F X"
  and "borel_predict_stoch_proc F Y"
shows "borel_predict_stoch_proc F (λt w. X t w + Y t w)" unfolding predict_stoch_proc_def
proof
  show "(λw. X 0 w + Y 0 w)  borel_measurable (F 0)"
    using assms(1) assms(2) borel_measurable_add predict_stoch_proc_def by blast
next
  show "n. (λw. X (Suc n) w + Y (Suc n) w)  borel_measurable (F n)"
  proof
    fix n
    have "X (Suc n)  borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
    moreover have "Y (Suc n)  borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
    ultimately show "(λw. X (Suc n) w + Y (Suc n) w)  borel_measurable (F n)" by simp
  qed
qed



lemma (in disc_filtr_prob_space) borel_predict_stoch_proc_sum:
  fixes A::"'d  nat  'a  ('c::{second_countable_topology, topological_comm_monoid_add})"
  assumes "i. i S  borel_predict_stoch_proc F (A i)"
shows "borel_predict_stoch_proc F (λ t w. ( i S. A i t w))" unfolding predict_stoch_proc_def
proof
  show "(λw. iS. A i 0 w)  borel_measurable (F 0)"
  proof
    have "i. i S A i 0  borel_measurable (F 0)" using assms unfolding predict_stoch_proc_def by simp
    thus "(λ w. ( i S. A i 0 w))  borel_measurable (F 0)" by (simp add:borel_measurable_sum)
  qed simp
next
  show "n. (λw. iS. A i (Suc n) w)  borel_measurable (F n)"
  proof
    fix n
    have "i. i S A i (Suc n)  borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
    thus "(λ w. ( i S. A i (Suc n) w))  borel_measurable (F n)" by (simp add:borel_measurable_sum)
  qed
qed


lemma (in disc_filtr_prob_space) borel_predict_stoch_proc_times:
  fixes X::"nat  'a  ('c::{second_countable_topology, real_normed_algebra})"
  assumes "borel_predict_stoch_proc F X"
  and "borel_predict_stoch_proc F Y"
shows "borel_predict_stoch_proc F (λt w. X t w * Y t w)" unfolding predict_stoch_proc_def
proof
  show "(λw. X 0 w * Y 0 w)  borel_measurable (F 0)"
  proof -
    have "X 0  borel_measurable (F 0)" using assms unfolding predict_stoch_proc_def by simp
    moreover have "Y 0  borel_measurable (F 0)" using assms unfolding predict_stoch_proc_def by simp
    ultimately show "(λw. X 0 w * Y 0 w)  borel_measurable (F 0)" by simp
  qed
next
  show "n. (λw. X (Suc n) w * Y (Suc n) w)  borel_measurable (F n)"
  proof
    fix n
    have "X (Suc n)  borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
    moreover have "Y (Suc n)  borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
    ultimately show "(λw. X (Suc n) w * Y (Suc n) w)  borel_measurable (F n)" by simp
  qed
qed

lemma (in disc_filtr_prob_space) borel_predict_stoch_proc_prod:
  fixes A::"'d  nat  'a  ('c::{second_countable_topology, real_normed_field})"
  assumes "i. i S  borel_predict_stoch_proc F (A i)"
shows "borel_predict_stoch_proc F (λ t w. ( i S. A i t w))" unfolding predict_stoch_proc_def
proof
  show "(λw. iS. A i 0 w)  borel_measurable (F 0)"
  proof -
    have "i. i S A i 0  borel_measurable (F 0)" using assms unfolding predict_stoch_proc_def by simp
    thus "(λ w. ( i S. A i 0 w))  borel_measurable (F 0)" by simp
  qed
next
  show "n. (λw. iS. A i (Suc n) w)  borel_measurable (F n)"
  proof
    fix n
    have "i. i S A i (Suc n)  borel_measurable (F n)" using assms unfolding predict_stoch_proc_def by simp
    thus "(λ w. ( i S. A i (Suc n) w))  borel_measurable (F n)" by simp
  qed
qed


definition (in prob_space) constant_image where
  "constant_image f = (if  c::'b::{t2_space}. x space M. f x = c then
    SOME c. x  space M. f x = c else undefined)"

lemma (in prob_space) constant_imageI:
  assumes "c::'b::{t2_space}. x space M. f x = c"
  shows "x space M. f x = (constant_image f)"
proof
  fix x
  assume "x space M"
  let ?c = "SOME c. x space M. f x = c"
  have "f x = ?c" using x space M someI_ex[of "λc. x space M. f x = c"] assms by blast
  thus "f x = (constant_image f)" by (simp add: assms prob_space.constant_image_def prob_space_axioms)
qed

lemma (in prob_space) constant_image_pos:
  assumes "x space M. (0::real) < f x"
  and "c::real. x space M. f x = c"
shows "0 < (constant_image f)"
proof -
  {
    fix x
    assume "x space M"
    hence "0 < f x" using assms by simp
    also have "... = constant_image f" using assms constant_imageI x space M by auto
    finally have ?thesis .
  }
  thus ?thesis using subprob_not_empty by auto
qed

definition open_except where
"open_except x y = (if x = y then {} else SOME A. open A  x A  y A)"


lemma open_exceptI:
  assumes "(x::'b::{t1_space})  y"
  shows "open (open_except x y)" and "x open_except x y" and  "y open_except x y"
proof-
  have ex:"U. open U  x  U  y  U" using x y by (simp add:t1_space)
  let ?V = "SOME A. open A  x A  y A"
  have vprop: "open ?V  x  ?V  y  ?V" using someI_ex[of "λU. open U  x  U  y  U"] ex by blast
  show "open (open_except x y)" by (simp add: open_except_def vprop)
  show "x open_except x y" by (metis (full_types) open_except_def vprop)
  show "y open_except x y" by (metis (full_types) open_except_def vprop)
qed

lemma open_except_set:
  assumes "finite A"
  and "(x::'b::{t1_space})  A"
shows "U. open U  x U  U A = {}"
proof(intro exI conjI)
  have "y A. x y" using assms by auto
  let ?U = " y  A. open_except x y"
  show "open ?U"
  proof (intro open_INT ballI, (simp add: assms))
    fix y
    assume "y A"
    show "open (open_except x y)" using y A. x y by (simp add: y  A open_exceptI)
  qed
  show "x  (yA. open_except x y)"
  proof
    fix y
    assume "y A"
    show "xopen_except x y" using y A. x y by (simp add: y  A open_exceptI)
  qed
  have "yA. y ?U" using y A. x y open_exceptI(3) by auto
  thus "(yA. open_except x y)  A = {}" by auto
qed

definition open_exclude_set where
"open_exclude_set x A = (if (U. open U  U A = {x}) then SOME U. open U  U  A = {x} else {})"

lemma open_exclude_setI:
  assumes "U. open U  U A = {x}"
shows "open (open_exclude_set x A)" and "(open_exclude_set x A)  A = {x}"
proof -
  let ?V = "SOME U. open U  U  A = {x}"
  have vprop: "open ?V  ?V  A = {x}" using someI_ex[of "λU. open U  U  A = {x}"] assms by blast
  show "open (open_exclude_set x A)" by (simp add: open_exclude_set_def vprop)
  show "open_exclude_set x A  A = {x}" by (metis (mono_tags, lifting) open_exclude_set_def vprop)
qed

lemma open_exclude_finite:
  assumes "finite A"
  and "(x::'b::{t1_space}) A"
shows open_set: "open (open_exclude_set x A)" and inter_x:"(open_exclude_set x A)  A = {x}"
proof -
  have "U. open U  U A = {x}"
  proof -
    have "U. open U  x U  U (A-{x}) = {}"
    proof (rule open_except_set)
      show "finite (A -{x})" using assms by auto
      show "x A -{x}" by simp
    qed
    thus ?thesis using assms by auto
  qed
  thus "open (open_exclude_set x A)" and "(open_exclude_set x A)  A = {x}" by (auto simp add: open_exclude_setI)
qed

subsection ‹Initially trivial filtrations›
text ‹Intuitively, these are filtrations that can be used to denote the fact that there is no information at the start.›

definition init_triv_filt::"'a measure  ('i::linorder_bot  'a measure)  bool" where
  "init_triv_filt M F  filtration M F  sets (F bot) = {{}, space M}"

lemma triv_measurable_cst:
  fixes f::"'a'b::{t2_space}"
  assumes "space N = space M"
  and "space M  {}"
  and "sets N = {{}, space M}"
  and "f measurable N borel"
shows " c::'b. x space N. f x = c"
proof -
  have "f `(space N)  {}" using assms by (simp add: assms)
  hence " c. c f`(space N)" by auto
  from this obtain c where "c f`(space N)" by auto
  have "x  space N. f x = c"
  proof
    fix x
    assume "x space N"
    show "f x = c"
    proof (rule ccontr)
      assume "f x  c"
      hence "(U V. open U  open V  (f x)  U  c  V  U  V = {})" by (simp add: separation_t2)
      from this obtain U and V where "open U" and "open V" and "(f x)  U" and "c  V" and "U  V = {}" by blast
      have "(f -`V)  space N = space N"
      proof -
        have "V sets borel" using ‹open V unfolding borel_def by simp
        hence "(f -`V)  space N  sets N" using assms unfolding measurable_def by simp
        show "(f -`V)  space N = space N"
        proof (rule ccontr)
          assume "(f -`V)  space N  space N"
          hence "(f -`V)  space N = {}" using assms (f -`V)  space N  sets N by simp
          thus False using cV using c  f ` space N by blast
        qed
      qed
      have "((f-`U) space N)  ((f-`V)  space N) = {}" using UV = {} by auto
      moreover have "(f -`U)  space N  sets N" using assms ‹open U unfolding measurable_def by simp
      ultimately have "(f -`U)  space N = {}" using assms (f -`V)  space N = space N by simp
      thus False using f x  U x  space N by blast
    qed
  qed
  thus " c. x space N. f x = c" by auto
qed

locale trivial_init_filtrated_prob_space = prob_space +
  fixes F
  assumes info_filtration: "init_triv_filt M F"

sublocale trivial_init_filtrated_prob_space  filtrated_prob_space
  using info_filtration unfolding init_triv_filt_def by (unfold_locales, simp)


locale triv_init_disc_filtr_prob_space = prob_space +
  fixes F
  assumes info_disc_filtr: "disc_filtr M F  sets (F bot) = {{}, space M}"

sublocale triv_init_disc_filtr_prob_space  trivial_init_filtrated_prob_space
proof unfold_locales
  show "init_triv_filt M F" using info_disc_filtr bot_nat_def unfolding init_triv_filt_def disc_filtr_def
    by (simp add: filtrationI)

qed


sublocale triv_init_disc_filtr_prob_space  disc_filtr_prob_space
proof unfold_locales
  show "disc_filtr M F" using info_disc_filtr by simp
qed

lemma (in triv_init_disc_filtr_prob_space) adapted_init:
  assumes "borel_adapt_stoch_proc F x"
  shows "c. w  space M. ((x 0 w)::real) = c"
proof -
  have "space M = space (F 0)" using filtration
    by (simp add: filtration_def subalgebra_def)
  moreover have "c. w  space (F 0). x 0 w = c"
  proof (rule triv_measurable_cst)
    show "space (F 0) = space M" using ‹space M = space (F 0) ..
    show "sets (F 0) = {{}, space M}" using info_disc_filtr
      by (simp add: init_triv_filt_def bot_nat_def)
    show "x 0  borel_measurable (F 0)" using assms by (simp add: adapt_stoch_proc_def)
    show "space M  {}" by (simp add:not_empty)
  qed
  ultimately show ?thesis by simp
qed

subsection ‹Filtration-equivalent measure spaces›
text ‹This is a relaxation of the notion of equivalent probability spaces, where equivalence is tested modulo a
filtration. Equivalent measure spaces agree on events that have a zero probability of occurring; here, filtration-equivalent
measure spaces agree on such events when they belong to the filtration under consideration.›

definition filt_equiv where
"filt_equiv F M N  sets M = sets N  filtration M F   ( t A. A  sets (F t)  (emeasure M A = 0)  (emeasure N A = 0))"


lemma filt_equiv_space:
  assumes "filt_equiv F M N"
  shows "space M = space N" using assms unfolding filt_equiv_def
 filtration_def subalgebra_def by (meson sets_eq_imp_space_eq)

lemma filt_equiv_sets:
  assumes "filt_equiv F M N"
  shows "sets M = sets N" using assms unfolding filt_equiv_def by simp



lemma filt_equiv_filtration:
  assumes "filt_equiv F M N"
  shows "filtration N F" using assms unfolding filt_equiv_def filtration_def subalgebra_def
  by (metis sets_eq_imp_space_eq)




lemma (in filtrated_prob_space) AE_borel_eq:
fixes f::"'areal"
assumes "f borel_measurable (F t)"
and "g borel_measurable (F t)"
and "AE w in M. f w = g w"
shows "{w space M. f w  g w}  sets (F t)  emeasure M {w space M. f w  g w} = 0"
proof
  show "{w  space M. f w  g w}  sets (F t)"
  proof -
    define minus where "minus = (λw. (f w) - (g w))"
    have "minus  borel_measurable (F t)" unfolding minus_def using assms by simp
    hence "{w space (F t). 0 < minus w}  sets (F t)" using borel_measurable_iff_greater by auto
    moreover have "{w space (F t). minus w < 0}  sets (F t)" using borel_measurable_iff_less
      minus  borel_measurable (F t) by auto
    ultimately have "{w space (F t). 0 < minus w}  {w space (F t). minus w < 0}  sets (F t)" by simp
    moreover have "{w space (F t). f w  g w} = {w space (F t). 0 < minus w}  {w space (F t). minus w < 0}"
    proof
      show "{w  space (F t). f w  g w}  {w  space (F t). 0 < minus w}  {w  space (F t). minus w < 0}"
      proof
        fix w
        assume "w  {w  space (F t). f w  g w}"
        hence "w space (F t)" and "f w  g w" by auto
        thus "w {w  space (F t). 0 < minus w}  {w  space (F t). minus w < 0}" unfolding minus_def
          by (cases "f w < g w") auto
      qed
      have "{w  space (F t). 0 < minus w}  {w  space (F t). f w  g w}" unfolding minus_def by auto
      moreover have "{w  space (F t). minus w < 0}  {w  space (F t). f w  g w}" unfolding minus_def by auto
      ultimately show "{w  space (F t). 0 < minus w}  {w  space (F t). minus w < 0}  {w  space (F t). f w  g w}"
        by simp
    qed
    moreover have "space (F t) = space M" using filtration unfolding filtration_def subalgebra_def by simp
    ultimately show ?thesis by simp
  qed
  show "emeasure M {w space M. f w  g w} = 0" by (metis (no_types) AE_iff_measurable assms(3) emeasure_notin_sets)
qed


lemma (in prob_space) filt_equiv_borel_AE_eq:
  fixes f::"'a real"
  assumes "filt_equiv F M N"
and "f borel_measurable (F t)"
and "g borel_measurable (F t)"
and "AE w in M. f w = g w"
shows "AE w in N. f w = g w"
proof -
  have set0: "{w space M. f w  g w}  sets (F t)  emeasure M {w space M. f w  g w} = 0"
  proof (rule filtrated_prob_space.AE_borel_eq, (auto simp add: assms))
    show "filtrated_prob_space M F" using assms unfolding filt_equiv_def
      by (simp add: filtrated_prob_space_axioms.intro filtrated_prob_space_def prob_space_axioms)
  qed
  hence "emeasure N {w space M. f w  g w} = 0" using assms unfolding filt_equiv_def by auto
  moreover have "{w space M. f w  g w}  sets N" using set0 assms unfolding filt_equiv_def
    filtration_def subalgebra_def by auto
  ultimately show ?thesis
  proof -
  have "space M = space N"
    by (metis assms(1) filt_equiv_space)
    then have "p. almost_everywhere N p  {a  space N. ¬ p a}  {a  space N. f a  g a}"
      using AE_iff_measurable ‹emeasure N {w  space M. f w  g w} = 0 {w  space M. f w  g w}  sets N
      by auto
    then show ?thesis
      by metis
  qed
qed

lemma filt_equiv_prob_space_subalgebra:
  assumes "prob_space N"
  and "filt_equiv F M N"
  and "sigma_finite_subalgebra M G"
shows "sigma_finite_subalgebra N G" unfolding sigma_finite_subalgebra_def
proof
  show "subalgebra N G"
    by (metis assms(2) assms(3) filt_equiv_space filt_equiv_def sigma_finite_subalgebra_def subalgebra_def)
  show "sigma_finite_measure (restr_to_subalg N G)" unfolding restr_to_subalg_def
    by (metis ‹subalgebra N G assms(1) finite_measure_def finite_measure_restr_to_subalg prob_space_def restr_to_subalg_def)
qed


lemma filt_equiv_measurable:
  assumes "filt_equiv F M N"
  and "f measurable M P"
shows "f measurable N P" using assms unfolding filt_equiv_def measurable_def
proof -
  assume a1: "sets M = sets N  Filtration.filtration M F  (t A. A  sets (F t)  (emeasure M A = 0) = (emeasure N A = 0))"
  assume a2: "f  {f  space M  space P. ysets P. f -` y  space M  sets M}"
  have "space N = space M"
    using a1 by (metis (lifting) sets_eq_imp_space_eq)
  then show "f  {f  space N  space P. Csets P. f -` C  space N  sets N}"
    using a2 a1 by force
qed


lemma filt_equiv_imp_subalgebra:
  assumes "filt_equiv F M N"
shows "subalgebra N M" unfolding subalgebra_def
  using assms filt_equiv_space filt_equiv_def by blast




end

Theory Martingale

(*  Title:      Martingale.thy
    Author:     Mnacho Echenim, Univ. Grenoble Alpes
*)

section ‹Martingales›

theory Martingale imports Filtration
begin

definition martingale  where
  "martingale M F X  
    (filtration M F)  (t. integrable M (X t))  (borel_adapt_stoch_proc F X) 
    (t s. t  s  (AE w in M. real_cond_exp M (F t) (X s) w = X t w))"

lemma martingaleAE:
  assumes "martingale M F X"
  and "t  s"
shows "AE w in M. real_cond_exp M (F t) (X s) w = (X t) w" using assms unfolding martingale_def by simp




lemma martingale_add:
  assumes "martingale M F X"
  and "martingale M F Y"
  and "m. sigma_finite_subalgebra M (F m)"
shows "martingale M F (λn w. X n w + Y n w)" unfolding martingale_def
proof (intro conjI)
  let ?sum = "λn w. X n w + Y n w"
  show "n. integrable M (λw. X n w + Y n w)"
  proof
    fix n
    show "integrable M (λw. X n w + Y n w)"
      by (metis Bochner_Integration.integrable_add assms(1) assms(2) martingale_def)
  qed
  show "n m. n  m  (AE w in M. real_cond_exp M (F n) (λw. X m w + Y m w) w = X n w + Y n w)"
  proof (intro allI impI)
    fix n::'b
    fix m
    assume "n  m"
    show "AE w in M. real_cond_exp M (F n) (λw. X m w + Y m w) w = X n w + Y n w"
    proof -
      have "integrable M (X m)" using assms unfolding martingale_def by simp
      moreover have "integrable M (Y m)" using assms unfolding martingale_def by simp
      moreover have " sigma_finite_subalgebra M (F n)" using assms by simp
      ultimately have "AE w in M. real_cond_exp M (F n) (λw. X m w + Y m w) w =
        real_cond_exp M (F n) (X m) w + real_cond_exp M (F n) (Y m) w"
        using sigma_finite_subalgebra.real_cond_exp_add[of M "F n" "X m" "Y m"] by simp
      moreover have "AE w in M. real_cond_exp M (F n) (X m) w = X n w" using n m assms
        unfolding martingale_def by simp
      moreover have "AE w in M. real_cond_exp M (F n) (Y m) w = Y n w" using n m assms
        unfolding martingale_def by simp
      ultimately show ?thesis by auto
    qed
  qed
  show "filtration M F" using assms unfolding martingale_def by simp
  show "borel_adapt_stoch_proc F (λn w. X n w + Y n w)" unfolding adapt_stoch_proc_def
  proof
    fix n
    show "(λw. X n w + Y n w)  borel_measurable (F n)" using assms unfolding martingale_def adapt_stoch_proc_def
      by (simp add: borel_measurable_add)
  qed
qed

lemma  disc_martingale_charact:
  assumes "(n. integrable M (X n))"
  and "filtration M F"
  and "m. sigma_finite_subalgebra M (F m)"
  and "m. X m  borel_measurable (F m)"
  and "(n. AE w in M. real_cond_exp M (F n) (X (Suc n)) w = (X n) w)"
shows "martingale M F X " unfolding martingale_def
proof (intro conjI)
  have " k m. k  m  (AE w in M. real_cond_exp M (F (m-k)) (X m) w = X (m-k) w)"
  proof (intro allI impI)
    fix m
    fix k::nat
    show "km  AE w in M. real_cond_exp M (F (m-k)) (X m) w = X (m-k) w"
    proof (induct k)
      case 0
      have "X m  borel_measurable (F m)" using assms by simp
      moreover have "integrable M (X m)" using assms by simp
      moreover have "sigma_finite_subalgebra M (F m)" using assms by simp
      ultimately have "AE w in M. real_cond_exp M (F m) (X m) w = X m w"
        using sigma_finite_subalgebra.real_cond_exp_F_meas[of M "F m" "X m"] by simp
      thus ?case using 0 by simp
    next
      case (Suc k)
      have "Suc (m - (Suc k)) = m - k" using Suc by simp
      hence "AE w in M. real_cond_exp M (F (m - (Suc k))) (X (Suc (m - (Suc k)))) w = (X (m - (Suc k))) w"
        using assms by blast
      hence "AE w in M. real_cond_exp M (F (m - (Suc k))) (X ((m - k))) w = (X (m - (Suc k))) w"
        using assms(3) ‹Suc (m - (Suc k)) = m - k by simp
      moreover have "AE w in M. real_cond_exp M (F (m - (Suc k))) (real_cond_exp M (F (m - k)) (X m)) w =
        real_cond_exp M (F (m - (Suc k))) (X m) w"
        using  sigma_finite_subalgebra.real_cond_exp_nested_subalg[of M "F (m- (Suc k))" "F (m-k)"  "X m"]
        by (metis Filtration.filtration_def Suc_n_not_le_n ‹Suc (m - Suc k) = m - k assms(1) assms(2) assms(3)
            filtrationE1 nat_le_linear)
      moreover have "AE w in M. real_cond_exp M (F (m - (Suc k))) (real_cond_exp M (F (m - k)) (X m)) w =
        real_cond_exp M (F (m - (Suc k))) (X (m-k)) w" using Suc
        sigma_finite_subalgebra.real_cond_exp_cong[of M "F (m - (Suc k))" "real_cond_exp M (F (m - k)) (X m)" "X (m - k)"]
        borel_measurable_cond_exp[of M "F (m-k)" "X m"]
        using Suc_leD assms(1) assms(3) borel_measurable_cond_exp2 by blast
      ultimately show ?case by auto
    qed
  qed
  thus " n m. n  m  (AE w in M. real_cond_exp M (F n) (X m) w = X n w)"
    by (metis diff_diff_cancel diff_le_self)
  show "t. integrable M (X t)" using assms by simp
  show "filtration M F" using assms by simp
  show "borel_adapt_stoch_proc F X" using assms unfolding adapt_stoch_proc_def by simp
qed


lemma (in finite_measure) constant_martingale:
  assumes "t. sigma_finite_subalgebra M (F t)"
and "filtration M F"
shows "martingale M F (λn w. c)" unfolding martingale_def
proof (intro allI conjI impI)
  show "filtration M F" using assms by simp
  {
    fix t
    show "integrable M (λw. c)" by simp
  }
  {
    fix t::'b
    fix s
    assume "t  s"
    show "AE w in M. real_cond_exp M (F t) (λw. c) w = c"
      by (intro sigma_finite_subalgebra.real_cond_exp_F_meas, (auto simp add: assms))
  }
  show "borel_adapt_stoch_proc F (λn w. c)" unfolding adapt_stoch_proc_def by simp
qed



end

Theory Disc_Cond_Expect

(*  Title:      Disc_Cond_Expect.thy
    Author:     Mnacho Echenim, Univ. Grenoble Alpes
*)

section ‹Discrete Conditional Expectation›

theory Disc_Cond_Expect imports "HOL-Probability.Probability" Generated_Subalgebra

begin

subsection ‹Preliminary measurability results›

text ‹These are some useful results, in particular when working with functions that have a countable
codomain.›

definition disc_fct  where
  "disc_fct f  countable (range f)"

definition  point_measurable where
  "point_measurable M S f  (f`(space M) S)  (  r  (range f)  S . f-`{r}  (space M)  sets M)"


lemma singl_meas_if:
  assumes "f  space M  space N"
  and "r range f space N. A sets N. range f A = {r}"
shows "point_measurable (fct_gen_subalgebra M N f) (space N) f" unfolding point_measurable_def
proof
  show "f`space (fct_gen_subalgebra M N f) space N" using assms
    by (simp add: Pi_iff fct_gen_subalgebra_space image_subsetI)
  show "(rrange f  space N. f -` {r}  space (fct_gen_subalgebra M N f)  sets (fct_gen_subalgebra M N f))"
  proof
    fix r
    assume "r range f  space N"
    hence "A sets N. range f A = {r}" using assms by blast
    from this obtain A where "A sets N" and "range f  A = {r}" by auto note Aprops = this
    hence "f-`A = f-`{r}" by auto
    hence "f-`A  space M = f-`{r}  space (fct_gen_subalgebra M N f)" by (simp add: fct_gen_subalgebra_space)
    thus "f -` {r}  space (fct_gen_subalgebra M N f)  sets (fct_gen_subalgebra M N f)"
      using Aprops fct_gen_subalgebra_sets_mem[of A N f M] by simp
  qed
qed

lemma  meas_single_meas:
  assumes "f measurable M N"
  and "r range f space N. A sets N. range f A = {r}"
shows "point_measurable M (space N) f"
proof -
  have "subalgebra M (fct_gen_subalgebra M N f) " using assms fct_gen_subalgebra_is_subalgebra by blast
  hence "sets (fct_gen_subalgebra M N f)  sets M" by (simp add: subalgebra_def)
  moreover have "point_measurable (fct_gen_subalgebra M N f) (space N) f" using assms singl_meas_if
    by (metis (no_types, lifting) Pi_iff measurable_space)
  ultimately show ?thesis
  proof -
    obtain bb :: "'a measure  'b set  ('a  'b)  'b" where
      f1: "m B f. (¬ point_measurable m B f  f ` space m  B  (b. b  range f  B  f -` {b}  space m  sets m))  (¬ f ` space m  B  bb m B f  range f  B  f -` {bb m B f}  space m  sets m  point_measurable m B f)"
      by (metis (no_types) point_measurable_def)
    moreover
    { assume "f -` {bb M (space N) f}  space (fct_gen_subalgebra M N f)  sets (fct_gen_subalgebra M N f)"
      then have "f -` {bb M (space N) f}  space M  sets (fct_gen_subalgebra M N f)"
        by (metis ‹subalgebra M (fct_gen_subalgebra M N f) subalgebra_def)
      then have "f -` {bb M (space N) f}  space M  sets M"
        using ‹sets (fct_gen_subalgebra M N f)  sets M by blast
      then have "f ` space M  space N  f -` {bb M (space N) f}  space M  sets M"
        using f1 by (metis ‹point_measurable (fct_gen_subalgebra M N f) (space N) f ‹subalgebra M (fct_gen_subalgebra M N f) subalgebra_def)
      then have ?thesis
        using f1 by metis }
    ultimately show ?thesis
      by (metis (no_types) ‹point_measurable (fct_gen_subalgebra M N f) (space N) f ‹subalgebra M (fct_gen_subalgebra M N f) subalgebra_def)
  qed
qed



definition countable_preimages where
"countable_preimages B Y = (λn. if ((infinite B)  (finite B  n < card B)) then Y -` {(from_nat_into B) n} else {})"

lemma  count_pre_disj:
  fixes i::nat
  assumes "countable B"
  and "i  j"
shows "(countable_preimages B Y) i  (countable_preimages B Y) j = {}"
proof (cases  "(countable_preimages B Y) i = {}  (countable_preimages B Y) j = {}")
  case True
  thus ?thesis by auto
next
  case False
  hence "Y -` {(from_nat_into B) i}  {}  Y -` {(from_nat_into B) j}  {}"  unfolding countable_preimages_def by meson
  have "(infinite B)  (finite B  i < card B  j < card B)" using False unfolding countable_preimages_def
    by meson
  have "(from_nat_into B) i  (from_nat_into B) j"
    by (metis False assms(1) assms(2) bij_betw_def countable_preimages_def from_nat_into_inj from_nat_into_inj_infinite lessThan_iff to_nat_on_finite)
  thus ?thesis
  proof -
    have f1: "A f n. if infinite A  finite A  n < card A then countable_preimages A f n = f -` {from_nat_into A n::'a} else countable_preimages A f n = ({}::'b set)"
      by (meson countable_preimages_def)
    then have f2: "infinite B  finite B  i < card B"
      by (metis (no_types) False)
    have "infinite B  finite B  j < card B"
      using f1 by (meson False)
    then show ?thesis
      using f2 f1 ‹from_nat_into B i  from_nat_into B j by fastforce
  qed
qed

lemma count_pre_surj:
  assumes "countable B"
  and "w  Y -`B"
shows "i. w  (countable_preimages B Y) i"
proof (cases "finite B")
  case True
    have " i < card B. (from_nat_into B) i = Y w"
      by (metis True assms(1) assms(2) bij_betw_def from_nat_into_to_nat_on image_eqI lessThan_iff
          to_nat_on_finite vimageE)
    from this obtain i where "i< card B" and "(from_nat_into B) i = Y w" by blast
    hence "w  (countable_preimages B Y) i"
      by (simp add: countable_preimages_def)
    thus "i. w  (countable_preimages B Y) i" by auto
  next
  case False
    hence " i. (from_nat_into B) i = Y w"
      by (meson assms(1) assms(2) from_nat_into_to_nat_on vimageE)
    from this obtain i where  "(from_nat_into B) i = Y w" by blast
    hence "w  (countable_preimages B Y) i"
      by (simp add: False countable_preimages_def)
    thus "i. w  (countable_preimages B Y) i" by auto
qed


lemma count_pre_img:
  assumes "x  (countable_preimages B Y) n"
  shows "Y x = (from_nat_into B) n"
proof -
  have "x Y -` {(from_nat_into B) n}" using assms unfolding countable_preimages_def
    by (meson empty_iff)
  thus ?thesis by simp
qed


lemma count_pre_union_img:
  assumes "countable B"
  shows "Y -`B = ( i. (countable_preimages B Y) i)"
proof (cases "B = {}")
  case False
  have "Y -`B  ( i. (countable_preimages B Y) i)"
    by (simp add: assms count_pre_surj subset_eq)
  moreover have "( i. (countable_preimages B Y) i)  Y -`B"
  proof -
    have f1: "b A f n. (b::'b)  countable_preimages A f n  (f b::'a) = from_nat_into A n"
      by (meson count_pre_img)
    have "range (from_nat_into B) = B"
      by (meson False assms range_from_nat_into)
    then show ?thesis
      using f1 by blast
  qed
  ultimately show ?thesis by simp
next
  case True
  hence " i. (countable_preimages B Y) i = {}" unfolding countable_preimages_def by simp
  hence "( i. (countable_preimages B Y) i) = {}" by auto
  moreover have "Y -`B = {}" using True by simp
  ultimately show ?thesis by simp
qed

lemma  count_pre_meas:
  assumes "point_measurable M (space N) Y"
  and "B space N"
  and "countable B"
  shows "i. (countable_preimages B Y) i  space M  sets M"
proof
  fix i
  have "Y -`B = ( i. (countable_preimages B Y) i)" using assms
    by (simp add: count_pre_union_img)
  show "countable_preimages B Y i  space M  sets M"
  proof (cases "countable_preimages B Y i = {}")
    case True
    thus ?thesis by simp
  next
    case False
    from this obtain y where "y  countable_preimages B Y i" by auto
    hence "countable_preimages B Y i = Y -`{Y y}"
      by (metis False count_pre_img countable_preimages_def)
    have "Y y = from_nat_into B i"
      by (meson y  countable_preimages B Y i count_pre_img)
    hence "Y y  space N"
      by (metis UNIV_I UN_I y  countable_preimages B Y i Y -`B = ( i. (countable_preimages B Y) i) assms(2)  empty_iff from_nat_into subsetCE vimage_empty)
    moreover have "Y y  range Y" by simp
    thus ?thesis
      by (metis IntI ‹countable_preimages B Y i = Y -` {Y y} assms(1) calculation point_measurable_def)
  qed
qed


lemma  disct_fct_point_measurable:
assumes "disc_fct f"
and "point_measurable M (space N) f"
shows "f measurable M N" unfolding measurable_def
proof
  show "f  space M  space N  (ysets N. f -` y  space M  sets M)"
  proof
    show "f  space M  space N" using assms unfolding point_measurable_def by auto
    show "ysets N. f -` y  space M  sets M"
    proof
      fix y
      assume "y sets N"
      let ?imY = "range f  y"
      have "f-`y = f-`?imY" by auto
      moreover have "countable ?imY" using assms unfolding disc_fct_def by auto
      ultimately have "f -`y = ( i. (countable_preimages ?imY f) i)" using assms count_pre_union_img by metis
      hence yeq: "f -` y  space M = ( i. ((countable_preimages ?imY f) i)  space M)" by auto
      have "i. countable_preimages ?imY f i  space M  sets M"
        by (metis ‹countable (range f  y) y  sets N assms(2) inf_le2 le_inf_iff count_pre_meas  sets.Int_space_eq1)
      hence "( i. ((countable_preimages ?imY f) i)  space M)  sets M" by blast
      thus "f -` y  space M  sets M" using yeq by simp
    qed
  qed
qed


lemma  set_point_measurable:
  assumes "point_measurable M (space N) Y"
  and "B  space N"
  and "countable B"
shows "(Y -`B)  space M  sets M"
proof -
  have "Y -`B = ( i. (countable_preimages B Y) i)" using assms
    by (simp add: count_pre_union_img)
  hence "Y -`B  space M = ( i. ((countable_preimages B Y) i  space M))"
    by auto
  have "i. (countable_preimages B Y) i  space M  sets M" using assms by (simp add: count_pre_meas)
  hence "( i. ((countable_preimages B Y) i  space M))  sets M" by blast
  show ?thesis
    using (i. countable_preimages B Y i  space M)  sets M Y -` B  space M = (i. countable_preimages B Y i  space M) by auto
qed


subsection ‹Definition of explicit conditional expectation›

text ‹This section is devoted to an explicit computation of a conditional expectation for random variables
that have a countable codomain. More precisely, the computed random variable is almost everywhere equal to a conditional
expectation of the random variable under consideration.›

definition  img_dce where
  "img_dce M Y X = (λ y. if measure M ((Y -` {y})  space M) = 0 then 0 else
    ((integralL M (λw. ((X w) * (indicator ((Y -`{y}) space M) w))))/(measure M ((Y -` {y})  space M))))"

definition  expl_cond_expect where
  "expl_cond_expect M Y X = (img_dce M Y X)  Y"

lemma  nn_expl_cond_expect_pos:
  assumes "w  space M. 0  X w"
shows " w space M. 0  (expl_cond_expect M Y X) w"
proof
  fix w
  assume space: "w space M"
  show "0  (expl_cond_expect M Y X) w"
  proof (cases "measure M ((Y -` {Y w}) space M) = 0")
    case True
    thus "0  (expl_cond_expect M Y X) w" unfolding expl_cond_expect_def img_dce_def by simp
  next
    case False
    hence "Y -`{Y w}  space M  sets M" using measure_notin_sets by blast
    let ?indA = "((λ x. indicator ((Y -`{Y w}) space M) x))"
    have "w  space M. 0  (X w) * (?indA w)" by (simp add: assms)
    hence  "0  (integralL M (λw. ((X w) * (?indA w))))" by simp
    moreover have "(expl_cond_expect M Y X) w = (integralL M (λw. ((X w) * (?indA w)))) / (measure M ((Y -` {Y w}) space M))"
      unfolding expl_cond_expect_def img_dce_def using False by simp
    moreover have "0 < measure M ((Y -` {Y w})  space M)" using False by (simp add: zero_less_measure_iff)
    ultimately show "0  (expl_cond_expect M Y X) w" by simp
  qed
qed



lemma  expl_cond_expect_const:
  assumes "Y w = Y y"
  shows "expl_cond_expect M Y X w = expl_cond_expect M Y X y"
    unfolding expl_cond_expect_def img_dce_def
    by (simp add: assms)


lemma  expl_cond_exp_cong:
  assumes "wspace M. X w = Z w"
shows "w space M. expl_cond_expect M Y X w = expl_cond_expect M Y Z w" unfolding expl_cond_expect_def img_dce_def
  by (metis (no_types, lifting) Bochner_Integration.integral_cong assms(1) o_apply)

(* example of a proof that IMO takes too long in Isabelle *)
lemma  expl_cond_exp_add:
  assumes "integrable M X"
  and "integrable M Z"
shows "w space M. expl_cond_expect M Y (λx. X x + Z x) w = expl_cond_expect M Y X w + expl_cond_expect M Y Z w"
proof
  fix w
  assume "w space M"
  define prY where "prY = measure M ((Y -` {Y w})  space M)"
  show "expl_cond_expect M Y (λx. X x + Z x) w = expl_cond_expect M Y X w + expl_cond_expect M Y Z w"
  proof (cases "prY = 0")
    case True
    thus ?thesis unfolding expl_cond_expect_def img_dce_def prY_def by simp
  next
    case False
    hence "(Y -` {Y w})  space M  sets M" unfolding prY_def using measure_notin_sets by blast
    let ?indA = "indicator ((Y -` {Y w})  space M)::('areal)"
    have "integrable M (λx. X x * ?indA x)"
      using Y -` {Y w}  space M  sets M assms(1) integrable_real_mult_indicator by blast
    moreover have "integrable M (λx. Z x * ?indA x)"
      using Y -` {Y w}  space M  sets M assms(2) integrable_real_mult_indicator by blast
    ultimately have "integralL M (λx. X x * ?indA x + Z x * ?indA x) = integralL M (λx. X x * ?indA x) + integralL M (λx. Z x * ?indA x)"
      using Bochner_Integration.integral_add by blast
    moreover have "x space M. X x * ?indA x + Z x * ?indA x = (X x + Z x) * ?indA x"
      by (simp add: indicator_def)
    ultimately have fsteq: "integralL M (λx. (X x + Z x) * ?indA x) = integralL M (λx. X x * ?indA x) + integralL M (λx. Z x * ?indA x)"
      by (metis (no_types, lifting) Bochner_Integration.integral_cong)
    have "integralL M (λx. (X x + Z x) * ?indA x/prY) = integralL M (λx. (X x + Z x) * ?indA x)/prY"
      by simp
    also have "... = integralL M (λx. X x * ?indA x)/prY + integralL M (λx. Z x * ?indA x)/prY" using fsteq
      by (simp add: add_divide_distrib)
    also have "... = integralL M (λx. X x * ?indA x/prY) + integralL M (λx. Z x * ?indA x/prY)" by auto
    finally have "integralL M (λx. (X x + Z x) * ?indA x/prY) = integralL M (λx. X x * ?indA x/prY) + integralL M (λx. Z x * ?indA x/prY)" .
    thus ?thesis using False unfolding expl_cond_expect_def img_dce_def
      by (simp add: add_divide_distrib fsteq)
  qed
qed


lemma expl_cond_exp_diff:
  assumes "integrable M X"
  and "integrable M Z"
shows "w space M. expl_cond_expect M Y (λx. X x - Z x) w = expl_cond_expect M Y X w - expl_cond_expect M Y Z w"
proof
  fix w
  assume "w space M"
  define prY where "prY = measure M ((Y -` {Y w})  space M)"
  show "expl_cond_expect M Y (λx. X x - Z x) w = expl_cond_expect M Y X w - expl_cond_expect M Y Z w"
  proof (cases "prY = 0")
    case True
    thus ?thesis unfolding expl_cond_expect_def img_dce_def prY_def by simp
  next
    case False
    hence "(Y -` {Y w})  space M  sets M" unfolding prY_def using measure_notin_sets by blast
    let ?indA = "indicator ((Y -` {Y w})  space M)::('areal)"
    have "integrable M (λx. X x * ?indA x)"
      using Y -` {Y w}  space M  sets M assms(1) integrable_real_mult_indicator by blast
    moreover have "integrable M (λx. Z x * ?indA x)"
      using Y -` {Y w}  space M  sets M assms(2) integrable_real_mult_indicator by blast
    ultimately have "integralL M (λx. X x * ?indA x - Z x * ?indA x) = integralL M (λx. X x * ?indA x) - integralL M (λx. Z x * ?indA x)"
      using Bochner_Integration.integral_diff by blast
    moreover have "x space M. X x * ?indA x - Z x * ?indA x = (X x - Z x) * ?indA x"
      by (simp add: indicator_def)
    ultimately have fsteq: "integralL M (λx. (X x - Z x) * ?indA x) = integralL M (λx. X x * ?indA x) - integralL M (λx. Z x * ?indA x)"
      by (metis (no_types, lifting) Bochner_Integration.integral_cong)
    have "integralL M (λx. (X x - Z x) * ?indA x/prY) = integralL M (λx. (X x - Z x) * ?indA x)/prY"
      by simp
    also have "... = integralL M (λx. X x * ?indA x)/prY - integralL M (λx. Z x * ?indA x)/prY" using fsteq
      by (simp add: diff_divide_distrib)
    also have "... = integralL M (λx. X x * ?indA x/prY) - integralL M (λx. Z x * ?indA x/prY)" by auto
    finally have "integralL M (λx. (X x - Z x) * ?indA x/prY) = integralL M (λx. X x * ?indA x/prY) - integralL M (λx. Z x * ?indA x/prY)" .
    thus ?thesis using False unfolding expl_cond_expect_def img_dce_def
      by (simp add: diff_divide_distrib fsteq)
  qed
qed

lemma  expl_cond_expect_prop_sets:
  assumes "disc_fct Y"
  and "point_measurable M (space N) Y"
  and "D = {w space M. Y w  space N  (P (expl_cond_expect M Y X w))}"
shows "D sets M"
proof -
  let ?C = "{y  (Y`(space M))  (space N). P (img_dce M Y X y)}"
  have "space M  UNIV" by simp
  hence "Y`(space M)  range Y" by auto
  hence "countable (Y`(space M))" using assms countable_subset unfolding disc_fct_def  by auto
  hence "countable ?C" using assms unfolding disc_fct_def by auto
  have eqset: "D = ( b ?C. Y-`{b}) space M"
  proof
    show "D ( b ?C. Y-`{b}) space M"
    proof
      fix w
      assume "w D"
      hence "w space M  Y w  (space N)  (P (expl_cond_expect M Y X w))"
        by (simp add: assms)
      hence "P (img_dce M Y X (Y w))" by (simp add: expl_cond_expect_def)
      hence "Y w  ?C" using w  space M  Y w  space N  P (expl_cond_expect M Y X w) by blast
      thus "w ( b ?C. Y-`{b}) space M"
        using w  space M  Y w  space N  P (expl_cond_expect M Y X w) by blast
    qed
    show "( b ?C. Y-`{b}) space M  D"
    proof
      fix w
      assume "w ( b ?C. Y-`{b}) space M"
      from this obtain b where "b ?C  w Y-`{b}" by auto note bprops = this
      hence "Y w = b" by auto
      hence "Y w space N" using bprops by simp
      show "w  D"
        by (metis (mono_tags, lifting) IntE Y w = b w  (b?C. Y -` {b})  space M assms(3)
            bprops mem_Collect_eq o_apply expl_cond_expect_def)
    qed
  qed
  also have "... = ( b ?C. Y-`{b} space M)" by blast
  finally have "D = ( b ?C. Y-`{b} space M)".
  have "b ?C. Y-`{b}  space M  sets M" using assms unfolding point_measurable_def by auto
  hence "( b ?C. Y-`{b} space M)  sets M" using ‹countable ?C by blast
  thus ?thesis
    using D = (b?C. Y -` {b}  space M) by blast
qed

lemma  expl_cond_expect_prop_sets2:
  assumes "disc_fct Y"
  and "point_measurable (fct_gen_subalgebra M N Y) (space N) Y"
  and "D = {w space M. Y w  space N  (P (expl_cond_expect M Y X w))}"
shows "D sets (fct_gen_subalgebra M N Y)"
proof -
  let ?C = "{y  (Y`(space M))  (space N). P (img_dce M Y X y)}"
  have "space M  UNIV" by simp
  hence "Y`(space M)  range Y" by auto
  hence "countable (Y`(space M))" using assms countable_subset unfolding disc_fct_def  by auto
  hence "countable ?C" using assms unfolding disc_fct_def by auto
  have eqset: "D = ( b ?C. Y-`{b}) space M"
  proof
    show "D ( b ?C. Y-`{b}) space M"
    proof
      fix w
      assume "w D"
      hence "w space M  Y w  (space N)  (P (expl_cond_expect M Y X w))"
        by (simp add: assms)
      hence "P (img_dce M Y X (Y w))" by (simp add: expl_cond_expect_def)
      hence "Y w  ?C" using w  space M  Y w  space N  P (expl_cond_expect M Y X w) by blast
      thus "w ( b ?C. Y-`{b}) space M"
        using w  space M  Y w  space N  P (expl_cond_expect M Y X w) by blast
    qed
    show "( b ?C. Y-`{b}) space M  D"
    proof
      fix w
      assume "w ( b ?C. Y-`{b}) space M"
      from this obtain b where "b ?C  w Y-`{b}" by auto note bprops = this
      hence "Y w = b" by auto
      hence "Y w space N" using bprops by simp
      show "w  D"
        by (metis (mono_tags, lifting) IntE Y w = b w  (b?C. Y -` {b})  space M assms(3)
            bprops mem_Collect_eq o_apply expl_cond_expect_def)
    qed
  qed
  also have "... = ( b ?C. Y-`{b} space M)" by blast
  finally have "D = ( b ?C. Y-`{b} space M)".
  have "space M = space (fct_gen_subalgebra M N Y)"
    by (simp add: fct_gen_subalgebra_space)
  hence "b ?C. Y-`{b}  space M  sets (fct_gen_subalgebra M N Y)" using assms unfolding point_measurable_def by auto
  hence "( b ?C. Y-`{b} space M)  sets (fct_gen_subalgebra M N Y)" using ‹countable ?C by blast
  thus ?thesis
    using D = (b?C. Y -` {b}  space M) by blast
qed





lemma  expl_cond_expect_disc_fct:
  assumes "disc_fct Y"
  shows "disc_fct (expl_cond_expect M Y X)"
   using assms unfolding disc_fct_def expl_cond_expect_def
    by (metis countable_image image_comp)







lemma  expl_cond_expect_point_meas:
  assumes "disc_fct Y"
  and "point_measurable M (space N) Y"
shows "point_measurable M UNIV (expl_cond_expect M Y X)"
proof -
  have "disc_fct (expl_cond_expect M Y X)" using assms by (simp add: expl_cond_expect_disc_fct)
  show ?thesis unfolding point_measurable_def
  proof
    show "(expl_cond_expect M Y X)`space M  UNIV" by simp
    show "rrange (expl_cond_expect M Y X)  UNIV. expl_cond_expect M Y X -` {r}  space M  sets M"
      proof
      fix r
      assume "r range (expl_cond_expect M Y X)  UNIV"
      let ?D = "{w  space M. Y w  space N  (expl_cond_expect M Y X w) = r}"
      have "?D  sets M" using expl_cond_expect_prop_sets[of Y M N ?D "λx. x = r" X] using assms by simp
      moreover have "expl_cond_expect M Y X -`{r} space M = ?D"
      proof
        show "expl_cond_expect M Y X -`{r} space M  ?D"
        proof
          fix w
          assume "w expl_cond_expect M Y X -`{r} space M"
          hence "Y w  space N"
            by (meson IntD2 assms(1) assms(2) disct_fct_point_measurable measurable_space)
          thus "w  ?D"
            using w  expl_cond_expect M Y X -` {r}  space M by blast
        qed
        show "?D  expl_cond_expect M Y X -`{r} space M"
        proof
          fix w
          assume "w ?D"
          thus "w expl_cond_expect M Y X -`{r} space M" by blast
        qed
      qed
      ultimately show "expl_cond_expect M Y X -` {r}  space M  sets M" by simp
    qed
  qed
qed

lemma  expl_cond_expect_borel_measurable:
  assumes "disc_fct Y"
  and "point_measurable M (space N) Y"
shows "(expl_cond_expect M Y X)  borel_measurable M" using expl_cond_expect_point_meas[of Y M] assms
          disct_fct_point_measurable[of "expl_cond_expect M Y X"]
        by (simp add: expl_cond_expect_disc_fct)



lemma  expl_cond_exp_borel:
  assumes "Y  space M  space N"
  and "disc_fct Y"
  and "r range Y space N. A sets N. range Y A = {r}"
  shows "(expl_cond_expect M Y X)  borel_measurable (fct_gen_subalgebra M N Y)"
proof (intro borel_measurableI)
  fix S::"real set"
  assume "open S"
  show "expl_cond_expect M Y X -` S  space (fct_gen_subalgebra M N Y)  sets (fct_gen_subalgebra M N Y)"
  proof (rule expl_cond_expect_prop_sets2)
    show "disc_fct Y" using assms by simp
    show "point_measurable (fct_gen_subalgebra M N Y) (space N) Y" using  assms
      by (simp add: singl_meas_if)
    show "expl_cond_expect M Y X -` S  space (fct_gen_subalgebra M N Y) = {w  space M. Y w  space N  (expl_cond_expect M Y X w)  S}"
    proof
      show " expl_cond_expect M Y X -` S  space (fct_gen_subalgebra M N Y)  {w  space M. Y w  space N  expl_cond_expect M Y X w  S}"
      proof
        fix x
        assume asm: "x  expl_cond_expect M Y X -` S  space (fct_gen_subalgebra M N Y)"
        hence "expl_cond_expect M Y X x  S" by auto
        moreover have  "x space M" using asm by (simp add:fct_gen_subalgebra_space)
        ultimately show "x {w  space M. Y w  space N  expl_cond_expect M Y X w  S}" using assms by auto
      qed
      show "{w  space M. Y w  space N  expl_cond_expect M Y X w  S}  expl_cond_expect M Y X -` S  space (fct_gen_subalgebra M N Y)"
      proof
        fix x
        assume asm2: "x  {w  space M. Y w  space N  expl_cond_expect M Y X w  S}"
        hence "x space (fct_gen_subalgebra M N Y)" by (simp add:fct_gen_subalgebra_space)
        moreover have "x  expl_cond_expect M Y X -`S" using asm2 by simp
        ultimately show "x  expl_cond_expect M Y X -` S  space (fct_gen_subalgebra M N Y)" by simp
      qed
    qed
  qed
qed





lemma  expl_cond_expect_indic_borel_measurable:
  assumes "disc_fct Y"
  and "point_measurable M (space N) Y"
  and "B space N"
  and "countable B"
  shows "(λw. expl_cond_expect M Y X w * indicator (countable_preimages B Y n  space M) w) borel_measurable M"
proof -
  have "countable_preimages B Y n  space M  sets M" using  assms by (auto simp add: count_pre_meas)
  have "(expl_cond_expect M Y X) borel_measurable M" using expl_cond_expect_point_meas[of Y M N X] assms
      disct_fct_point_measurable[of "expl_cond_expect M Y X"]
    by (simp add: expl_cond_expect_disc_fct)
  moreover have "(indicator (countable_preimages B Y n  space M)) borel_measurable M"
    using ‹countable_preimages B Y n  space M  sets M borel_measurable_indicator by blast
  ultimately show ?thesis
    using borel_measurable_times by blast
qed


lemma (in finite_measure) dce_prod:
  assumes "point_measurable M (space N) Y"
   and "integrable M X"
   and " w space M. 0  X w"
shows " w. (Y w)  space N  (expl_cond_expect M Y X) w * measure M ((Y -` {Y w}) space M) = integralL M (λy. (X y) * (indicator ((Y -`{Y w}) space M) y))"
proof (intro allI impI)
  fix w
  assume "Y w space N"
  let ?indY = "(λy. indicator ((Y -`{Y w}) space M) y)::'a  real"
  show "expl_cond_expect M Y X w * measure M ((Y -` {Y w}) space M) = integralL M (λy. (X y) * ?indY y) "
  proof (cases "AE y in M. ?indY y = 0")
    case True
    (* Very long proof, Sledgehammer was lost. Everything had to be detailed *)
    hence "emeasure M ((Y -` {Y w}) space M) = 0"
    proof -
      have "AE y in M. y   Y -` {Y w}  space M"
        using True eventually_elim2 by auto
      hence "N null_sets M.{x space M. ¬(x Y -` {Y w}  space M)}  N"
        using eventually_ae_filter[of "λx. x  Y -` {Y w}  space M" M] by simp
      hence "N null_sets M. {x space M. x Y -` {Y w}  space M}  N" by simp
      from this obtain N where "N null_sets M" and "{x space M. x Y -` {Y w}  space M}  N" by auto
          note Nprops = this
      have "{x space M. x Y -` {Y w}}  N" using Nprops by auto
      hence "emeasure M {x space M. x Y -` {Y w}}  emeasure M N"
        by (simp add: emeasure_mono Nprops(1) null_setsD2)
      thus ?thesis
        by (metis (no_types, lifting) Collect_cong Int_def Nprops(1) le_zero_eq null_setsD1)
    qed
    hence "enn2real (emeasure M ((Y -` {Y w}) space M)) = 0" by simp
    hence "measure M ((Y -` {Y w}) space M) = 0" unfolding measure_def by simp
    hence lhs: "expl_cond_expect M Y X w = 0" unfolding expl_cond_expect_def img_dce_def by simp
    have  zer: "AE y in M. (X y) * ?indY y = (λy. 0) y" using True by auto
    hence rhs: "integralL M  (λy. (X y) * ?indY y) = 0"
    proof -
      have " w space M. 0  X w * ?indY w" using assms by simp
      have "integrable M (λy. (X y) * ?indY y)" using assms
        by (metis (mono_tags, lifting) IntI UNIV_I Y w  space N image_eqI integrable_cong integrable_real_mult_indicator point_measurable_def)
      hence "(λy. (X y) * ?indY y)  borel_measurable M" by blast
      thus ?thesis using zer integral_cong_AE[of "(λy. (X y) * ?indY y)" M "λy. 0"] by simp
    qed
    thus "expl_cond_expect M Y X w*measure M ((Y -` {Y w}) space M) = integralL M (λy. (X y) * ?indY y)" using lhs rhs by simp
  next
    case False
    hence "¬(AE y in M. y  (Y -`{Y w}) space M)"
      by (simp add: indicator_eq_0_iff)
    hence "emeasure M ((Y -` {Y w}) space M)  0"
    proof -
      have "(Y -` {Y w}) space M sets M"
        by (meson IntI UNIV_I Y w  space N assms(1) image_eqI point_measurable_def)
      have "(Y -` {Y w}) space M  null_sets M"
        using ¬ (AE y in M. y  Y -` {Y w}  space M) eventually_ae_filter by blast
      thus ?thesis
        using Y -` {Y w}  space M  sets M by blast
    qed
    hence "measure M ((Y -` {Y w}) space M)  0"
      by (simp add: emeasure_eq_measure)
    thus "expl_cond_expect M Y X w* measure M ((Y -` {Y w}) space M) = integralL M (λy. (X y) * ?indY y)" unfolding expl_cond_expect_def img_dce_def
      using o_apply by auto
  qed
qed



lemma  expl_cond_expect_const_exp:
  shows "integralL M (λy. expl_cond_expect M Y X w * (indicator (Y -` {Y w}  space M)) y) =
    integralL M (λy. expl_cond_expect M Y X y * (indicator (Y -` {Y w}  space M)) y)"
proof -
  let ?ind = "(indicator (Y -` {Y w}  space M))"
  have " y space M. expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
  proof
    fix y
    assume "y space M"
    show "expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
    proof (cases "y Y -` {Y w}  space M")
      case False
      thus ?thesis by simp
    next
      case True
      hence "Y w = Y y" by auto
      hence "expl_cond_expect M Y X w = expl_cond_expect M Y X y"
        using expl_cond_expect_const[of Y w y M X] by simp
      thus ?thesis by simp
    qed
  qed
  thus ?thesis
    by (meson Bochner_Integration.integral_cong)
qed

lemma  nn_expl_cond_expect_const_exp:
  assumes "w space M. 0  X w"
  shows "integralN M (λy. expl_cond_expect M Y X w * (indicator (Y -` {Y w}  space M)) y) =
    integralN M (λy. expl_cond_expect M Y X y * (indicator (Y -` {Y w}  space M)) y)"
proof -
  let ?ind = "(indicator (Y -` {Y w}  space M))"
  have forall: " y space M. expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
  proof
    fix y
    assume "y space M"
    show "expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
    proof (cases "y Y -` {Y w}  space M")
      case False
      thus ?thesis by simp
    next
      case True
      hence "Y w = Y y" by auto
      hence "expl_cond_expect M Y X w = expl_cond_expect M Y X y"
        using expl_cond_expect_const[of Y] by blast
      thus ?thesis by simp
    qed
  qed
  show ?thesis
    by (metis (no_types, lifting) forall nn_integral_cong)
qed


lemma (in finite_measure) nn_expl_cond_bounded:
  assumes "w space M. 0  X w"
  and "integrable M X"
  and "point_measurable M (space N) Y"
  and "w space M"
  and "Y w space N"
  shows "integralN M (λy. expl_cond_expect M Y X y * (indicator (Y -` {Y w}  space M)) y) < "
proof -
  let ?ind = "(indicator (Y -` {Y w}  space M))::'areal"
  have "0  expl_cond_expect M Y X w" using assms nn_expl_cond_expect_pos[of M X Y] by simp
  have "integrable M (λy. expl_cond_expect M Y X w * ?ind y)"
  proof -
    have eq: "(Y -`{Y w}  space M)  space M = (Y -`{Y w}  space M)" by auto
    have "(Y -` {Y w}  space M)  sets M" using assms
      by (simp add: point_measurable_def)
    moreover have "emeasure M (Y -`{Y w}  space M) < " by (simp add: inf.strict_order_iff)
    ultimately have "integrable M (λy. ?ind y)"
      using integrable_indicator_iff[of M "(Y -`{Y w}  space M)"] by simp
    thus ?thesis using integrable_mult_left_iff[of M "expl_cond_expect M Y X w" "?ind"] by blast
  qed
  have "y space M. 0  expl_cond_expect M Y X w * ?ind y"
    using 0  expl_cond_expect M Y X w mult_nonneg_nonneg by blast
  hence "y space M. expl_cond_expect M Y X w * ?ind y = norm (expl_cond_expect M Y X w * ?ind y)" by auto
  hence inf: "integralN M (λy. expl_cond_expect M Y X w * ?ind y) < "
    using integrable_iff_bounded[of M "(λy. expl_cond_expect M Y X w * ?ind y)"]
      0  expl_cond_expect M Y X w  real_norm_def nn_integral_cong
    by (metis (no_types, lifting) ‹integrable M (λy. expl_cond_expect M Y X w * indicator (Y -` {Y w}  space M) y))
  have "integralN M (λy. expl_cond_expect M Y X y * ?ind y) =
    integralN M (λy. expl_cond_expect M Y X w * ?ind y)" using assms
    by (simp add: nn_expl_cond_expect_const_exp)
  also have "... < "  using inf by simp
  finally show ?thesis .
qed


lemma (in finite_measure)  count_prod:
  fixes Y::"'a'b"
  assumes "B space N"
  and "point_measurable M (space N) Y"
  and "integrable M X"
  and " w  space M. 0  X w"
shows "i. integralL M (λy. (X y) * (indicator (countable_preimages B Y i  space M)) y) =
  integralL M (λy. (expl_cond_expect M Y X y) * (indicator (countable_preimages B Y i  space M)) y)"
proof
  fix i
  show "integralL M (λy. X y * indicator (countable_preimages B Y i  space M) y) =
         integralL M (λy. expl_cond_expect M Y X y * indicator (countable_preimages B Y i  space M) y)"
  proof (cases "countable_preimages B Y i  space M = {}")
    case True
    thus ?thesis by simp
  next
    case False
    from this obtain w where "w countable_preimages B Y i" by auto
    hence "Y w = (from_nat_into B) i" by (meson count_pre_img)
    hence "Y w  B"
    proof (cases "infinite B")
      case True
      thus ?thesis
        by (simp add: Y w = from_nat_into B i from_nat_into infinite_imp_nonempty)
    next
      case False
      thus ?thesis
        by (metis Finite_Set.card_0_eq Y w = from_nat_into B i w  countable_preimages B Y i countable_preimages_def equals0D from_nat_into gr_implies_not0)
    qed
    let ?ind = "(indicator (Y -` {Y w}  space M))::'areal"
    have "integralL M (λy. (X y) * (indicator (countable_preimages B Y i  space M)) y) = integralL M (λy. X y * ?ind y)"
      by (metis (no_types, hide_lams) Y w = from_nat_into B i thesis. (w. w  countable_preimages B Y i  thesis)  thesis countable_preimages_def empty_iff)
    also have "... =
      expl_cond_expect M Y X w * measure M (Y -` {Y w}  space M)"  using dce_prod[of N Y X]
       by (metis (no_types, lifting) Y w  B assms subsetCE)
    also have "... = expl_cond_expect M Y X w * (integralL M ?ind)"
       by auto
    also have "... = integralL M (λy. expl_cond_expect M Y X w * ?ind y)"
       by auto
    also have "... = integralL M (λy. expl_cond_expect M Y X y * ?ind y)"
    proof -
      have " y space M. expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
      proof
        fix y
        assume "y space M"
        show "expl_cond_expect M Y X w * ?ind y = expl_cond_expect M Y X y * ?ind y"
        proof (cases "y Y -` {Y w}  space M")
          case False
          thus ?thesis by simp
        next
          case True
          hence "Y w = Y y" by auto
          hence "expl_cond_expect M Y X w = expl_cond_expect M Y X y"
            using expl_cond_expect_const[of Y] by blast
          thus ?thesis by simp
        qed
      qed
      thus ?thesis
        by (meson Bochner_Integration.integral_cong)
    qed
    also have "... = integralL M (λy. expl_cond_expect M Y X y * indicator (countable_preimages B Y i  space M) y)"
      by (metis (no_types, hide_lams) Y w = from_nat_into B i thesis. (w. w  countable_preimages B Y i  thesis)  thesis countable_preimages_def empty_iff)
    finally show ?thesis .
  qed
qed



lemma (in finite_measure) count_pre_integrable:
  assumes "point_measurable M (space N) Y"
  and "disc_fct Y"
  and "B space N"
  and "countable B"
  and "integrable M X"
  and " w  space M. 0  X w"
shows "integrable M (λw. expl_cond_expect M Y X w * indicator (countable_preimages B Y n  space M) w)"
proof-
  have "integralL M (λy. (X y) * (indicator (countable_preimages B Y n  space M)) y) =
  integralL M (λy. (expl_cond_expect M Y X y) * (indicator (countable_preimages B Y n  space M)) y)" using assms count_prod
    by blast
  have "w  space M. 0  (expl_cond_expect M Y X w) * (indicator (countable_preimages B Y n  space M)) w"
    by (simp add: assms nn_expl_cond_expect_pos)
  have "countable_preimages B Y n  space M  sets M" using count_pre_meas[of M] assms by auto
  hence "integrable M (λw. X w * indicator (countable_preimages B Y n  space M) w)"
    using assms integrable_real_mult_indicator by blast
  show ?thesis
  proof (rule integrableI_nonneg)
    show "(λw. expl_cond_expect M Y X w * indicator (countable_preimages B Y n  space M) w) borel_measurable M"
    proof -
      have "(expl_cond_expect M Y X) borel_measurable M" using expl_cond_expect_point_meas[of Y M N X] assms
          disct_fct_point_measurable[of "expl_cond_expect M Y X"]
        by (simp add: expl_cond_expect_disc_fct)
      moreover have "(indicator (countable_preimages B Y n  space M)) borel_measurable M"
        using ‹countable_preimages B Y n  space M  sets M borel_measurable_indicator by blast
      ultimately show ?thesis
        using borel_measurable_times by blast
    qed
    show "AE x in M. 0  expl_cond_expect M Y X x * indicator (countable_preimages B Y n  space M) x"
      by (simp add: wspace M. 0  expl_cond_expect M Y X w * indicator (countable_preimages B Y n  space M) w)
    show "(+ x. ennreal (expl_cond_expect M Y X x * indicator (countable_preimages B Y n  space M) x) M) < "
    proof (cases "countable_preimages B Y n  space M = {}")
      case True
      thus ?thesis by simp
    next
      case False
      from this obtain w where "w countable_preimages B Y n space M" by auto
      hence "countable_preimages B Y n = Y -`{Y w}"
        by (metis IntD1 count_pre_img countable_preimages_def equals0D)
      have "w space M" using False
        using w  countable_preimages B Y n  space M by blast
      moreover have "Y w  space N"
        by (meson w  space M assms(1) assms(2) disct_fct_point_measurable measurable_space)
      ultimately show ?thesis using assms nn_expl_cond_bounded[of X N Y]
        using ‹countable_preimages B Y n = Y -` {Y w} by presburger
    qed
  qed
qed





lemma (in finite_measure) nn_cond_expl_is_cond_exp_tmp:
  assumes " w space M. 0  X w"
  and "integrable M X"
  and "disc_fct  Y"
  and "point_measurable M (space M') Y"
shows " A  sets M'. integrable M (λw. ((expl_cond_expect M Y X) w) * (indicator ((Y -`A) (space M)) w)) 
  integralL M (λw. (X w) * (indicator ((Y -`A) (space M)) w)) =
  integralL M (λw. ((expl_cond_expect M Y X) w) * (indicator ((Y -`A)  (space M))) w)"
proof
  fix A
  assume "A  sets M'"
  let ?imA = "A  (range Y)"
  have "countable ?imA" using assms disc_fct_def by blast
  have "Y -`A = Y -`?imA" by auto
  define prY where "prY = countable_preimages ?imA Y"
  have un: "Y -`?imA = ( i. prY i)" using ‹countable ?imA
    by (metis count_pre_union_img prY_def)
   have "(Y -`?imA)  (space M) = ( i. prY i)  (space M)" using Y -`A = Y -`?imA un  by simp
   also have "... = ( i. (prY i)  (space M))" by blast
   finally have eq2: "(Y -`?imA)  (space M) = ( i. (prY i)  (space M))".
   define indpre::"nat  'a  real" where "indpre = (λ i x. (indicator ((prY i)  (space M))) x)"
   have " i. indpre i  borel_measurable M"
   proof
     fix i
     show "indpre i  borel_measurable M" unfolding indpre_def prY_def
     proof (rule borel_measurable_indicator, cases "countable_preimages (A  range Y) Y i  space M = {}")
       case True
       thus "countable_preimages (A  range Y) Y i  space M  sets M" by simp
     next
       case False
       from this obtain x where "x countable_preimages (A  range Y) Y i  space M" by blast
           hence "Y x  space M'"
             by (metis Int_iff UN_I A  sets M' prY  countable_preimages (A  range Y) Y imageE
                 rangeI sets.sets_into_space subset_eq un vimage_eq)
           thus "countable_preimages (A  range Y) Y i  space M  sets M"
             by (metis IntE IntI x  countable_preimages (A  range Y) Y i  space M assms(4)
                 count_pre_img countable_preimages_def empty_iff point_measurable_def rangeI)
     qed
   qed
   have "i. integrable M (λw. (X w) * indpre i w)"
   proof
     fix i
     show "integrable M (λw. (X w) * indpre i w)" unfolding indpre_def prY_def
     proof (rule integrable_real_mult_indicator)
       show "countable_preimages (A  range Y) Y i  space M  sets M"
       proof (cases "countable_preimages (A  range Y) Y i = {}")
         case True
         thus "countable_preimages (A  range Y) Y i  space M  sets M"  by (simp add: True)
       next
         case False
         hence "Y -` {(from_nat_into (A  range Y)) i}  {}"  unfolding countable_preimages_def by meson
         have "(infinite (A  range Y))  (finite (A  range Y)  i < card (A  range Y))" using False unfolding countable_preimages_def
           by meson
         show ?thesis
           by (metis A  sets M' ‹countable (A  range Y) assms(4) count_pre_meas le_inf_iff
               range_from_nat_into sets.Int_space_eq1 sets.empty_sets sets.sets_into_space subset_range_from_nat_into)
       qed
       show "integrable M X" using assms by simp
     qed
   qed
   hence prod_bm: " i. (λw. (X w) * indpre i w)  borel_measurable M"
     by (simp add: assms(2) borel_measurable_integrable borel_measurable_times)
   have posprod: " i w. 0  (X w) * indpre i w"
   proof (intro allI)
     fix i
     fix w
     show "0  (X w) * indpre i w"
       by (metis IntE assms(1) indicator_pos_le indicator_simps(2) indpre_def mult_eq_0_iff mult_sign_intros(1))
   qed
   let ?indA = "indicator ((Y -`(A  range Y)) (space M))::'areal"

   have " i j. i  j  ((prY i)  (space M))  ((prY j)  (space M)) = {}"
     by (simp add: ‹countable (A  range Y) prY  countable_preimages (A  range Y) Y count_pre_disj inf_commute inf_sup_aci(3))
   hence sumind: "x. (λi. indpre i x) sums ?indA x" using ‹countable ?imA eq2 unfolding prY_def indpre_def
     by (metis indicator_sums)
   hence sumxlim: "x. (λi. (X x) * indpre i x::real) sums ((X x) * indicator ((Y -`?imA)  (space M)) x)" using ‹countable ?imA unfolding prY_def
     using sums_mult by blast
   hence sum: "x. ( i.((X x) * indpre i x)::real) = (X x) * indicator ((Y -`?imA)  (space M)) x"  by (metis sums_unique)
   hence b: " w. 0  ( i.((X w) * indpre i w))" using suminf_nonneg
     by (metis x. (λi. X x * indpre i x) sums (X x * indicator (Y -` (A  range Y)  space M) x) posprod summable_def)
   have sumcondlim: "x. (λi. (expl_cond_expect M Y X x) * indpre i x::real) sums ((expl_cond_expect M Y X x) * ?indA x)" using ‹countable ?imA unfolding prY_def
     using sums_mult sumind by blast

   have "integrable M (λw. (X w) * ?indA w)"
   proof (rule integrable_real_mult_indicator)
     show "Y -` (A range Y)  space M  sets M"
       using A  sets M' assms(3) assms(4) disct_fct_point_measurable measurable_sets
       by (metis Y -` A = Y -` (A  range Y))
     show "integrable M X" using assms by simp
   qed
   hence intsum: "integrable M (λw. (i. ((X w) * indpre i w)))" using sum
       integrable_cong[of M M "λ w.(X w) * (indicator ((Y -`A) (space M)) w)" "λw. ( i.((X w) * indpre i w))"]
     using Y -` A = Y -` (A  range Y) by presburger
   have "integralL M (λw. (X w) * ?indA w) = integralL M (λw. ( i.((X w) * indpre i w)))"
     using Y -` A = Y -` (A  range Y) sum by auto
   also have "... =
      + w.   (( i. ((X w) * indpre i w))) M" using nn_integral_eq_integral
     by (metis (mono_tags, lifting) AE_I2 intsum b  nn_integral_cong)
   also have "(+ w.   (( i. ((X w) * indpre i w))) M) =  + w.   (( i. ennreal ((X w) * indpre i w))) M" using suminf_ennreal2 summable_def posprod sum sumxlim
   proof -
     { fix aa :: 'a
       have "a. ennreal (n. X a * indpre n a) = (n. ennreal (X a * indpre n a))"
         by (metis (full_types) posprod suminf_ennreal2 summable_def sumxlim)
       then have "(+ a. ennreal (n. X a * indpre n a) M) = (+ a. (n. ennreal (X a * indpre n a)) M)  ennreal (n. X aa * indpre n aa) = (n. ennreal (X aa * indpre n aa))"
         by metis }
     then show ?thesis
       by presburger
   qed
   also have "... = (i. integralN M ((λi w. (X w) * indpre i w) i))"
   proof (intro nn_integral_suminf)
     fix i
     show "(λx. ennreal (X x * indpre i x)) borel_measurable M"
       using measurable_compose_rev measurable_ennreal prod_bm by blast
   qed
   also have "... = (i. integralN M ((λi w. (expl_cond_expect M Y X w) * indpre i w) i))"
   proof (intro suminf_cong)
     fix n
     have "A  range Y  space M'"
       using A  sets M' sets.Int_space_eq1 by auto
     have "integralN M (λw. (X w) * indpre n w) = integralL M (λw. (X w) * indpre n w)"
       using nn_integral_eq_integral[of M "λw. (X w) * indpre n w"]
       by (simp add: i. integrable M (λw. X w * indpre i w) posprod)
     also have "... = integralL M (λw. (expl_cond_expect M Y X) w * indpre n w)"
     proof -
       have "integralL M (λw. X w * indicator (countable_preimages (A  range Y) Y n  space M) w) =
         integralL M (λw. expl_cond_expect M Y X w * indicator (countable_preimages (A  range Y) Y n  space M) w)"
         using count_prod[of "A range Y" "M'" Y X ] assms A  range Y  space M' by blast
       thus ?thesis
         using indpre  λi. indicator (prY i  space M) prY_def by presburger
     qed
     also have "... = integralN M (λw. (expl_cond_expect M Y X) w * indpre n w)"
     proof -
       have "integrable M (λw. (expl_cond_expect M Y X) w * indpre n w)" unfolding indpre_def prY_def
       using count_pre_integrable assms A  range Y  space M' ‹countable (A  range Y) by blast
       moreover have "AE w in M. 0  (expl_cond_expect M Y X) w * indpre n w"
         by (simp add: indpre  λi. indicator (prY i  space M) assms(1) nn_expl_cond_expect_pos)
       ultimately show ?thesis by (simp add:nn_integral_eq_integral)
     qed
     finally show "integralN M (λw. (X w) * indpre n w) = integralN M (λw. (expl_cond_expect M Y X) w * indpre n w)" .
   qed
   also have "... = integralN M (λw. i. ((expl_cond_expect M Y X w) * indpre i w))"
   proof -
     have "(λx. (i. ennreal (expl_cond_expect M Y X x * indpre i x))) =
      (λx. ennreal (i. (expl_cond_expect M Y X x * indpre i x)))"
     proof-
       have posex: " i x. 0  (expl_cond_expect M Y X x) * (indpre i x)"
         by (metis IntE indpre  λi. indicator (prY i  space M) assms(1) indicator_pos_le indicator_simps(2) mult_eq_0_iff mult_sign_intros(1) nn_expl_cond_expect_pos)
       have "x. (i. ennreal (expl_cond_expect M Y X x * indpre i x)) =  (ennreal (i. (expl_cond_expect M Y X x * indpre i x)))"
       proof
         fix x
         show "(i. ennreal (expl_cond_expect M Y X x * indpre i x)) =  (ennreal (i. (expl_cond_expect M Y X x * indpre i x)))"
           using suminf_ennreal2[of "λi. (expl_cond_expect M Y X x * indpre i x)"] sumcondlim summable_def posex
         proof -
           have f1: "summable (λn. expl_cond_expect M Y X x * indpre n x)"
             using sumcondlim summable_def by blast
           obtain nn :: nat where
             "¬ 0  expl_cond_expect M Y X x * indpre nn x  ¬ summable (λn. expl_cond_expect M Y X x * indpre n x)  ennreal (n. expl_cond_expect M Y X x * indpre n x) = (n. ennreal (expl_cond_expect M Y X x * indpre n x))"
             by (metis (full_types) i. 0  expl_cond_expect M Y X x * indpre i x; summable (λi. expl_cond_expect M Y X x * indpre i x)  (i. ennreal (expl_cond_expect M Y X x * indpre i x)) = ennreal (i. expl_cond_expect M Y X x * indpre i x))
           then show ?thesis
             using f1 posex by presburger
         qed
       qed
       thus ?thesis by simp
     qed
     have "i. (λw. (expl_cond_expect M Y X w) * indpre i w)  borel_measurable M"
     proof -
       show ?thesis
         using i. (indpre i) borel_measurable M assms(3) assms(4) borel_measurable_times expl_cond_expect_borel_measurable by blast
     qed
     hence "i. (λx. ennreal (expl_cond_expect M Y X x * indpre i x)) borel_measurable M"
       using measurable_compose_rev measurable_ennreal by blast
     thus ?thesis using nn_integral_suminf[of "(λi w.  (expl_cond_expect M Y X w) * indpre i w)" M, symmetric]
       using (λx. i. ennreal (expl_cond_expect M Y X x * indpre i x)) = (λx. ennreal (i. expl_cond_expect M Y X x * indpre i x)) by auto
   qed
   also have "... = integralN M (λw. (expl_cond_expect M Y X w) * ?indA w)"
     using sumcondlim
     by (metis (no_types, lifting) sums_unique)
   also have "... = integralL M (λw. (expl_cond_expect M Y X w) * ?indA w)"
   proof -
     have scdint: "integrable M (λw. (expl_cond_expect M Y X w) * ?indA w)"
     proof -
       have rv: "(λw. (expl_cond_expect M Y X w) * indicator ((Y -`?imA)  (space M)) w)  borel_measurable M"
       proof -
         have "expl_cond_expect M Y X  borel_measurable M" using expl_cond_expect_borel_measurable
           using assms by blast
         moreover have "(Y -`?imA)  (space M)  sets M"
           by (metis A  sets M' Y -` A = Y -` (A  range Y) assms(3) assms(4) disct_fct_point_measurable measurable_sets)
         ultimately show ?thesis
           using borel_measurable_indicator_iff borel_measurable_times  by blast
       qed
       moreover have born:  "integralN M (λw. ennreal (norm (expl_cond_expect M Y X w * ?indA w))) < "
       proof -
         have "integralN M (λw. ennreal (norm (expl_cond_expect M Y X w * ?indA w))) =
            integralN M (λw. ennreal (expl_cond_expect M Y X w * ?indA w))"
         proof -
           have "w space M. norm (expl_cond_expect M Y X w * ?indA w) = expl_cond_expect M Y X w * ?indA w"
             using nn_expl_cond_expect_pos by (simp add: nn_expl_cond_expect_pos assms(1))
           thus ?thesis by (metis (no_types, lifting) nn_integral_cong)
         qed
         thus ?thesis
           by (metis (no_types, lifting)
             (i. + x. ennreal (X x * indpre i x) M) = (i. + x. ennreal (expl_cond_expect M Y X x * indpre i x) M)
             (i. + x. ennreal (expl_cond_expect M Y X x * indpre i x) M) = (+ x. ennreal (i. expl_cond_expect M Y X x * indpre i x) M)
             (+ w. (i. ennreal (X w * indpre i w)) M) = (i. + x. ennreal (X x * indpre i x) M)
             (+ x. ennreal (i. X x * indpre i x) M) = (+ w. (i. ennreal (X w * indpre i w)) M)
             (+ x. ennreal (i. expl_cond_expect M Y X x * indpre i x) M) = (+ x. ennreal (expl_cond_expect M Y X x * indicator (Y -` (A  range Y)  space M) x) M)
             ‹ennreal (integralL M (λw. i. X w * indpre i w)) = (+ x. ennreal (i. X x * indpre i x) M)
             ennreal_less_top infinity_ennreal_def)
         qed
       show "integrable M (λw. (expl_cond_expect M Y X w) * ?indA w)"
       proof (rule iffD2[OF integrable_iff_bounded])
         show "((λw. expl_cond_expect M Y X w * indicator (Y -` (A  range Y)  space M) w)  borel_measurable M) 
          ((+ x. (ennreal (norm (expl_cond_expect M Y X x * indicator (Y -` (A  range Y)  space M) x))) M) < )"
         proof
           show "(λw. expl_cond_expect M Y X w * indicator (Y -` (A  range Y)  space M) w) borel_measurable M"
             using rv by simp
           show "(+ x. ennreal (norm (expl_cond_expect M Y X x * indicator (Y -` (A  range Y)  space M) x)) M) < "
             using born by simp
         qed
       qed
     qed
     moreover have "w space M. 0  (expl_cond_expect M Y X w) * indicator ((Y -`?imA)  (space M)) w"
       by (simp add: assms(1) nn_expl_cond_expect_pos)
     ultimately show ?thesis using nn_integral_eq_integral
       by (metis (mono_tags, lifting) AE_I2 nn_integral_cong)
   qed
   finally have myeq: "ennreal (integralL M (λw. (X w) * ?indA w)) = integralL M (λw. (expl_cond_expect M Y X w) * ?indA w)" .

    thus "integrable M (λw. expl_cond_expect M Y X w * indicator (Y -` A  space M) w)  integralL M (λw. X w * indicator (Y -` A  space M) w) =
         integralL M  (λw. expl_cond_expect M Y X w * indicator (Y -` A  space M) w)"
    proof -
      have "0  integralL M (λw. X w * indicator (Y -` A  space M) w)"
        using Y -` A = Y -` (A  range Y) b sum by fastforce
      moreover have "0  integralL M (λw. expl_cond_expect M Y X w * indicator (Y -` A  space M) w)"
        by (simp add:  assms(1) nn_expl_cond_expect_pos)
      ultimately have expeq: "integralL M (λw. X w * indicator (Y -` A  space M) w) =
         integralL M  (λw. expl_cond_expect M Y X w * indicator (Y -` A  space M) w)"
        by (metis (mono_tags, lifting) Bochner_Integration.integral_cong Y -` A = Y -` (A  range Y) ennreal_inj myeq)
      have "integrable M (λw. (expl_cond_expect M Y X w) * ?indA w)"
       proof -
         have rv: "(λw. (expl_cond_expect M Y X w) * indicator ((Y -`?imA)  (space M)) w)  borel_measurable M"
         proof -
           have "expl_cond_expect M Y X  borel_measurable M" using expl_cond_expect_borel_measurable
             using assms by blast
           moreover have "(Y -`?imA)  (space M)  sets M"
             by (metis A  sets M' Y -` A = Y -` (A  range Y) assms(3) assms(4) disct_fct_point_measurable measurable_sets)
           ultimately show ?thesis
             using borel_measurable_indicator_iff borel_measurable_times  by blast
         qed
         moreover have born:  "integralN M (λw. ennreal (norm (expl_cond_expect M Y X w * ?indA w))) < "
         proof -
           have "integralN M (λw. ennreal (norm (expl_cond_expect M Y X w * ?indA w))) =
              integralN M (λw. ennreal (expl_cond_expect M Y X w * ?indA w))"
           proof -
             have "w space M. norm (expl_cond_expect M Y X w * ?indA w) = expl_cond_expect M Y X w * ?indA w"
               using nn_expl_cond_expect_pos by (simp add: nn_expl_cond_expect_pos assms(1))
             thus ?thesis by (metis (no_types, lifting) nn_integral_cong)
           qed
           thus ?thesis
             by (metis (no_types, lifting)
               (i. + x. ennreal (X x * indpre i x) M) = (i. + x. ennreal (expl_cond_expect M Y X x * indpre i x) M)
               (i. + x. ennreal (expl_cond_expect M Y X x * indpre i x) M) = (+ x. ennreal (i. expl_cond_expect M Y X x * indpre i x) M)
               (+ w. (i. ennreal (X w * indpre i w)) M) = (i. + x. ennreal (X x * indpre i x) M)
               (+ x. ennreal (i. X x * indpre i x) M) = (+ w. (i. ennreal (X w * indpre i w)) M)
               (+ x. ennreal (i. expl_cond_expect M Y X x * indpre i x) M) = (+ x. ennreal (expl_cond_expect M Y X x * indicator (Y -` (A  range Y)  space M) x) M)
               ‹ennreal (integralL M (λw. i. X w * indpre i w)) = (+ x. ennreal (i. X x * indpre i x) M)
               ennreal_less_top infinity_ennreal_def)
           qed
         show "integrable M (λw. (expl_cond_expect M Y X w) * ?indA w)"
         proof (rule iffD2[OF integrable_iff_bounded])
           show "((λw. expl_cond_expect M Y X w * indicator (Y -` (A  range Y)  space M) w)  borel_measurable M) 
            ((+ x. (ennreal (norm (expl_cond_expect M Y X x * indicator (Y -` (A  range Y)  space M) x))) M) < )"
           proof
             show "(λw. expl_cond_expect M Y X w * indicator (Y -` (A  range Y)  space M) w) borel_measurable M"
               using rv by simp
             show "(+ x. ennreal (norm (expl_cond_expect M Y X x * indicator (Y -` (A  range Y)  space M) x)) M) < "
               using born by simp
           qed
         qed
       qed
       hence "integrable M (λw. expl_cond_expect M Y X w * indicator (Y -` A  space M) w)"
         using Y -` A = Y -` (A  range Y) by presburger
      thus ?thesis  using expeq by simp
    qed
  qed



lemma (in finite_measure) nn_expl_cond_exp_integrable:
  assumes " w space M. 0  X w"
  and "integrable M X"
  and "disc_fct  Y"
  and "point_measurable M (space N) Y"
shows "integrable M (expl_cond_expect M Y X)"
proof -
  have "Y-`space N  space M = space M"
    by (meson assms(3) assms(4) disct_fct_point_measurable inf_absorb2 measurable_space subsetI vimageI)
  let ?indA = "indicator ((Y -`space N) (space M))::'areal"
  have "w space M. (?indA w)= (1::real)" by (simp add: Y -` space N  space M = space M)
  hence "w space M. ((expl_cond_expect M Y X) w) * (?indA w) = (expl_cond_expect M Y X) w" by simp
  moreover have "integrable M (λw. ((expl_cond_expect M Y X) w) * (?indA w))" using assms
      nn_cond_expl_is_cond_exp_tmp[of X Y N] by blast
  ultimately show ?thesis by (metis (no_types, lifting) integrable_cong)
qed

lemma (in finite_measure) nn_cond_expl_is_cond_exp:
  assumes " w space M. 0  X w"
  and "integrable M X"
  and "disc_fct  Y"
  and "point_measurable M (space N) Y"
shows " A  sets N. integralL M (λw. (X w) * (indicator ((Y -`A) (space M)) w)) =
  integralL M (λw. ((expl_cond_expect M Y X) w) * (indicator ((Y -`A)  (space M))) w)"
  by (metis (mono_tags, lifting) assms nn_cond_expl_is_cond_exp_tmp)

lemma (in finite_measure) expl_cond_exp_integrable:
  assumes "integrable M X"
    and "disc_fct Y"
    and "point_measurable M (space N) Y"
  shows "integrable M (expl_cond_expect M Y X)"
proof -
  let ?zer = "λw. 0"
  let ?Xp = "λw. max (?zer w) (X w)"
  let ?Xn = "λw. max (?zer 0) (-X w)"
  have "w. X w = ?Xp w - ?Xn w" by auto
  have ints: "integrable M ?Xp" "integrable M ?Xn" using integrable_max assms by auto
  hence "integrable M (expl_cond_expect M Y ?Xp)" using assms nn_expl_cond_exp_integrable
    by (metis max.cobounded1)
  moreover have "integrable M (expl_cond_expect M Y ?Xn)" using ints assms nn_expl_cond_exp_integrable
    by (metis max.cobounded1)
  ultimately have integr: "integrable M (λw. (expl_cond_expect M Y ?Xp) w - (expl_cond_expect M Y ?Xn) w)" by auto
  have "w space M. (expl_cond_expect M Y ?Xp) w - (expl_cond_expect M Y ?Xn) w = (expl_cond_expect M Y X) w"
  proof
    fix w
    assume "w space M"
    hence "(expl_cond_expect M Y ?Xp) w - (expl_cond_expect M Y ?Xn) w = (expl_cond_expect M Y (λx. ?Xp x - ?Xn x)) w"
      using ints by (simp add: expl_cond_exp_diff)
    also have "... = expl_cond_expect M Y X w" using expl_cond_exp_cong w. X w = ?Xp w - ?Xn w by auto
    finally show "(expl_cond_expect M Y ?Xp) w - (expl_cond_expect M Y ?Xn) w = expl_cond_expect M Y X w" .
  qed
  thus ?thesis using integr
    by (metis (mono_tags, lifting) integrable_cong)
qed


lemma (in finite_measure) is_cond_exp:
  assumes "integrable M X"
  and "disc_fct  Y"
  and "point_measurable M (space N) Y"
shows " A  sets N. integralL M (λw. (X w) * (indicator ((Y -`A) (space M)) w)) =
  integralL M (λw. ((expl_cond_expect M Y X) w) * (indicator ((Y -`A)  (space M))) w)"
proof -
  let ?zer = "λw. 0"
  let ?Xp = "λw. max (?zer w) (X w)"
  let ?Xn = "λw. max (?zer 0) (-X w)"
  have "w. X w = ?Xp w - ?Xn w" by auto
  have ints: "integrable M ?Xp" "integrable M ?Xn" using integrable_max assms by auto
  hence posint: "integrable M (expl_cond_expect M Y ?Xp)" using assms nn_expl_cond_exp_integrable
    by (metis max.cobounded1)
  have negint: "integrable M (expl_cond_expect M Y ?Xn)" using ints assms nn_expl_cond_exp_integrable
    by (metis max.cobounded1)
  have eqp: " A  sets N. integralL M (λw. (?Xp w) * (indicator ((Y -`A) (space M)) w)) =
    integralL M (λw. ((expl_cond_expect M Y ?Xp) w) * (indicator ((Y -`A)  (space M))) w)"
    using nn_cond_expl_is_cond_exp[of ?Xp Y N] assms  by auto
  have eqn: " A  sets N. integralL M (λw. (?Xn w) * (indicator ((Y -`A) (space M)) w)) =
    integralL M (λw. ((expl_cond_expect M Y ?Xn) w) * (indicator ((Y -`A)  (space M))) w)"
    using nn_cond_expl_is_cond_exp[of ?Xn Y N] assms  by auto

  show " A  sets N. integralL M (λw. (X w) * (indicator ((Y -`A) (space M)) w)) =
    integralL M (λw. ((expl_cond_expect M Y X) w) * (indicator ((Y -`A)  (space M))) w)"
  proof
    fix A
    assume "A sets N"
    let ?imA = "A  (range Y)"
    have "countable ?imA" using assms disc_fct_def by blast
    have "Y -`A = Y -`?imA" by auto
    have yev: "Y -` (A range Y)  space M  sets M"
        using A  sets N assms(3) assms(2) disct_fct_point_measurable measurable_sets
        by (metis Y -` A = Y -` (A  range Y))
    let ?indA = "indicator ((Y -`(A  range Y)) (space M))::'areal"
    have intp: "integrable M (λw. (?Xp w) * ?indA w)"
    proof (rule integrable_real_mult_indicator)
      show "Y -` (A range Y)  space M  sets M" using yev by simp
      show "integrable M ?Xp" using assms by simp
    qed
    have intn: "integrable M (λw. (?Xn w) * ?indA w)"
    proof (rule integrable_real_mult_indicator)
      show "Y -` (A range Y)  space M  sets M" using yev by simp
      show "integrable M ?Xn" using assms by simp
    qed
    have exintp: "integrable M (λw. (expl_cond_expect M Y ?Xp w) * ?indA w)"
    proof (rule integrable_real_mult_indicator)
      show "Y -` (A range Y)  space M  sets M" using yev by simp
      show "integrable M (expl_cond_expect M Y ?Xp)" using posint by simp
    qed
    have exintn: "integrable M (λw. (expl_cond_expect M Y ?Xn w) * ?indA w)"
    proof (rule integrable_real_mult_indicator)
      show "Y -` (A range Y)  space M  sets M" using yev by simp
      show "integrable M (expl_cond_expect M Y ?Xn)" using negint by simp
    qed
    have "integralL M (λw. X w * indicator (Y -` A  space M) w) =
      integralL M (λw. (?Xp w - ?Xn w) * indicator (Y -` A  space M) w)"
      using w. X w =?Xp w - ?Xn w by auto
    also have "... =   integralL M (λw. (?Xp w * indicator (Y -` A  space M) w) - ?Xn w * indicator (Y -` A  space M) w)"
      by (simp add: left_diff_distrib)
    also have "... = integralL M (λw. (?Xp w * indicator (Y -` A  space M) w)) -
      integralL M (λw. ?Xn w * indicator (Y -` A  space M) w)"
      using Y -` A = Y -` (A  range Y) intp intn by auto
    also have "... = integralL M (λw. ((expl_cond_expect M Y ?Xp) w) * (indicator ((Y -`A)  (space M))) w) -
      integralL M (λw. ((expl_cond_expect M Y ?Xn) w) * (indicator ((Y -`A)  (space M))) w)"
      using eqp eqn by (simp add: A  sets N)
    also have "... = integralL M (λw. ((expl_cond_expect M Y ?Xp) w) * (indicator ((Y -`A)  (space M))) w -
      ((expl_cond_expect M Y ?Xn) w) * (indicator ((Y -`A)  (space M))) w)"
      using Y -` A = Y -` (A  range Y) exintn exintp by auto
    also have "... = integralL M (λw. ((expl_cond_expect M Y ?Xp) w - (expl_cond_expect M Y ?Xn) w) * (indicator ((Y -`A)  (space M))) w)"
      by (simp add: left_diff_distrib)
    also have "... = integralL M (λw. ((expl_cond_expect M Y (λx. ?Xp x - ?Xn x) w) * (indicator ((Y -`A)  (space M))) w))"
      using expl_cond_exp_diff[of M ?Xp ?Xn Y] ints by (metis (mono_tags, lifting) Bochner_Integration.integral_cong)
    also have "... = integralL M (λw. ((expl_cond_expect M Y X w) * (indicator ((Y -`A)  (space M))) w))"
      using w. X w = ?Xp w - ?Xn w expl_cond_exp_cong[of M X "λx. ?Xp x - ?Xn x" Y] by presburger
    finally show "integralL M (λw. X w * indicator (Y -` A  space M) w) = integralL M (λw. ((expl_cond_expect M Y X w) * (indicator ((Y -`A)  (space M))) w))" .
  qed
qed


lemma (in finite_measure) charact_cond_exp:
  assumes "disc_fct Y"
    and "integrable M X"
    and "point_measurable M (space N) Y"
    and "Y  space M  space N"
    and "r range Y space N. A sets N. range Y A = {r}"
  shows "AE w in M. real_cond_exp M (fct_gen_subalgebra M N Y) X w = expl_cond_expect M Y X w"
proof (rule sigma_finite_subalgebra.real_cond_exp_charact)
  have "Y measurable M N"
    by (simp add: assms(1) assms(3) disct_fct_point_measurable)
  have "point_measurable M (space N) Y" by (simp add: assms(3))
  show "sigma_finite_subalgebra M (fct_gen_subalgebra M N Y)" unfolding sigma_finite_subalgebra_def
  proof
    show "subalgebra M (fct_gen_subalgebra M N Y)" using Y measurable M N by (simp add: fct_gen_subalgebra_is_subalgebra)
    show "sigma_finite_measure (restr_to_subalg M (fct_gen_subalgebra M N Y))" unfolding sigma_finite_measure_def
    proof (intro exI conjI)
      let ?A = "{space M}"
      show "countable ?A" by simp
      show "?A  sets (restr_to_subalg M (fct_gen_subalgebra M N Y))"
        by (metis empty_subsetI insert_subset sets.top space_restr_to_subalg)
      show " ?A = space (restr_to_subalg M (fct_gen_subalgebra M N Y))"
        by (simp add: space_restr_to_subalg)
      show "a{space M}. emeasure (restr_to_subalg M (fct_gen_subalgebra M N Y)) a  "
        by (metis ‹subalgebra M (fct_gen_subalgebra M N Y) emeasure_finite emeasure_restr_to_subalg infinity_ennreal_def sets.top singletonD subalgebra_def)
    qed
  qed
  show "integrable M X" using assms by simp
  show "expl_cond_expect M Y X  borel_measurable (fct_gen_subalgebra M N Y)" using assms by (simp add:expl_cond_exp_borel)
  show "integrable M (expl_cond_expect M Y X)"
    using assms expl_cond_exp_integrable  by blast
  have "A sets M. integralL M (λw. (X w) * (indicator A w)) = set_lebesgue_integral M A X"
    by (metis (no_types, lifting) Bochner_Integration.integral_cong mult_commute_abs real_scaleR_def set_lebesgue_integral_def)
   have "A sets M. integralL M (λw. ((expl_cond_expect M Y X) w) * (indicator A w)) = set_lebesgue_integral M A (expl_cond_expect M Y X)"
    by (metis (no_types, lifting) Bochner_Integration.integral_cong mult_commute_abs real_scaleR_def set_lebesgue_integral_def)
  have "A sets (fct_gen_subalgebra M N Y). integralL M (λw. (X w) * (indicator A w)) =
  integralL M (λw. ((expl_cond_expect M Y X) w) * (indicator A w))"
  proof
    fix A
    assume "A  sets (fct_gen_subalgebra M N Y)"
    hence "A  {Y -` B  space M |B. B  sets N}" using assms by (simp add:fct_gen_subalgebra_sigma_sets)
    hence "B  sets N. A = Y -`B  space M" by auto
    from this obtain B where "B sets N" and "A = Y -`B space M" by auto
    thus "integralL M (λw. (X w) * (indicator A w)) =
      integralL M (λw. ((expl_cond_expect M Y X) w) * (indicator A w))" using is_cond_exp
      using Bochner_Integration.integral_cong ‹point_measurable M (space N) Y assms(1) assms(2) by blast
  qed
  thus "A. A  sets (fct_gen_subalgebra M N Y)  set_lebesgue_integral M A X = set_lebesgue_integral M A (expl_cond_expect M Y X)"
    by (smt Bochner_Integration.integral_cong Groups.mult_ac(2) real_scaleR_def set_lebesgue_integral_def)
qed


lemma (in finite_measure) charact_cond_exp':
  assumes "disc_fct Y"
    and "integrable M X"
    and "Y measurable M N"
    and "r range Y space N. A sets N. range Y A = {r}"
  shows "AE w in M. real_cond_exp M (fct_gen_subalgebra M N Y) X w = expl_cond_expect M Y X w"
proof (rule charact_cond_exp)
  show "disc_fct Y" using assms by simp
  show "integrable M X" using assms by simp
  show "rrange Y  space N. Asets N. range Y  A = {r}" using assms by simp
  show "Y space M  space N"
    by (meson Pi_I assms(3) measurable_space)
  show "point_measurable M (space N) Y" using assms by (simp add: meas_single_meas)
qed



end

Theory Infinite_Coin_Toss_Space

(*  Title:      Infinite_Coin_Toss_Space.thy
    Author:     Mnacho Echenim, Univ. Grenoble Alpes
*)

section ‹Infinite coin toss space›

text ‹This section contains the formalization of the infinite coin toss space, i.e., the probability
space constructed on infinite sequences of independent coin tosses.›

theory Infinite_Coin_Toss_Space imports Filtration Generated_Subalgebra Disc_Cond_Expect

begin

subsection ‹Preliminary results›

lemma decompose_init_prod:
  fixes n::nat
  shows "( i {0..n}. f i) = f 0 * ( i {1..n}. f i)"
proof (cases "Suc 0  n")
  case True
  thus ?thesis
    by (metis One_nat_def Suc_le_D True prod.atLeast0_atMost_Suc_shift prod.atLeast_Suc_atMost_Suc_shift)
next
  case False
  thus ?thesis
    by (metis One_nat_def atLeastLessThanSuc_atLeastAtMost prod.atLeast0_lessThan_Suc_shift
        prod.atLeast_Suc_lessThan_Suc_shift)
qed


lemma Inter_nonempty_distrib:
  assumes "A  {}"
  shows "A  B = ( C A. (C B))"
proof
  show "(CA. C  B)  A  B"
  proof
    fix x
    assume mem: "x  (CA. C  B)"
    from A  {} obtain C where "C A" by blast
    hence "x C B" using mem by blast
    hence in1: "x B" by auto
    have "C. C A  x  CB" using mem by blast
    hence "C. C A  x C" by auto
    hence in2: "x A" by auto
    thus "x A  B" using in1 in2 by simp
  qed
qed auto



lemma enn2real_sum: shows "finite A  (a. a A f a < top) enn2real (sum f A) = ( a A. enn2real (f a))"
proof (induct rule:finite_induct)
  case empty
  thus ?case by simp
next
  case (insert a A)
  have "enn2real (sum f (insert a A)) = enn2real (f a + (sum f A))"
    by (simp add: insert.hyps(1) insert.hyps(2))
  also have "... = enn2real (f a) + enn2real (sum f A)"
    by (simp add: enn2real_plus insert.hyps(1) insert.prems)
  also have "... = enn2real (f a) + ( a A. enn2real (f a))"
    by (simp add: insert.hyps(3) insert.prems)
  also have "... = ( a (insert a A). enn2real (f a))"
    by (metis calculation insert.hyps(1) insert.hyps(2) sum.insert)
  finally show ?case .
qed

lemma ennreal_sum: shows "finite A  (a. 0  f a)  (a A. ennreal (f a)) = ennreal (a A. f a)"
proof (induct rule:finite_induct)
  case empty
  thus ?case by simp
next
  case (insert a A)
  have "(a (insert a A). ennreal (f a)) = ennreal (f a) + (a A. ennreal (f a))"
    by (simp add: insert.hyps(1) insert.hyps(2))
  also have "... = ennreal (f a) + ennreal (a A. f a)"
    by (simp add: insert.prems)
  also have "... = ennreal (f a + (a A. f a))"
    by (simp add: insert.prems sum_nonneg)
  also have "... = ennreal (a (insert a A). (f a))"
    using insert.hyps(1) insert.hyps(2) by auto
  finally show ?case .
qed


lemma stake_snth:
  assumes "stake n w = stake n x"
  shows "Suc i  n  snth w i = snth x i"
by (metis Suc_le_eq assms stake_nth)

lemma stake_snth_charact:
  assumes "stake n w = stake n x"
  shows "i < n. snth w i = snth x i"
proof (intro allI impI)
  fix i
  assume "i < n"
  thus "snth w i = snth x i" using Suc_leI assms stake_snth by blast
qed

lemma stake_snth':
  shows "(i. Suc i  n  snth w i = snth x i) stake n w = stake n x"
proof (induct n arbitrary:w x)
case 0
  then show ?case by auto
next
case (Suc n)
  hence mh: "i. Suc i  Suc n  w !! i = x !! i" by auto
  hence seq:"snth w n = snth x n"  by auto
  have "stake n w = stake n x" using mh Suc by (meson Suc_leD Suc_le_mono)
  thus "stake (Suc n) w = stake (Suc n) x" by (metis seq stake_Suc)
qed

lemma  stake_inter_snth:
  fixes x
  assumes "Suc 0  n"
  shows "{w space M. (stake n w = stake n x)} = ( i  {0.. n-1}. {w space M. (snth w i = snth x i)})"
proof
  let ?S =  "{w space M. (stake n w = stake n x)}"
  show "?S  (i{0..n-1}. {w  space M. w !! i = x !! i})" using stake_snth assms by fastforce
  show "(i{0..n-1}. {w  space M. w !! i = x !! i})  ?S"
  proof
    fix w
    assume inter: "w  (i{0..n-1}. {w  space M. w !! i = x !! i})"
    have " i. 0  i  i  n-1  snth w i = snth x i"
    proof (intro allI impI)
      fix i
      assume "0  i  i  n-1"
      thus "snth w i = snth x i" using inter by auto
    qed
    hence "stake n w = stake n x"
      by (metis One_nat_def Suc_le_D diff_Suc_Suc diff_is_0_eq diff_zero le0 stake_snth')
    thus "w ?S" using inter by auto
  qed
qed

lemma streams_stake_set:
  shows "pw  streams A  set (stake n pw)  A"
proof (induct n arbitrary: pw)
  case (Suc n) note hyp = this
  have "set (stake (Suc 0) pw)  A"
  proof -
    have "shd pw  A" using hyp  streams_shd[of pw A] by simp
    have "stake (Suc 0) pw = [shd pw]" by auto
    hence "set (stake (Suc 0) pw) = {shd pw}" by auto
    thus ?thesis using ‹shd pw  A by auto
  qed
  thus ?case by (simp add: Suc.hyps Suc.prems streams_stl)
qed simp


lemma stake_finite_universe_induct:
  assumes "finite A"
  and "A  {}"
  shows "(stake (Suc n) `(streams A)) = {s#w| s w. s A  w (stake n `(streams A))}" (is "?L = ?R")
proof
  show "?L  ?R"
  proof
    fix l::"'a list"
    assume "l ?L"
    hence "pw. pw  streams A  l = stake (Suc n) pw" by auto
    from this obtain pw where "pw  streams A" and  "l = stake (Suc n) pw" by blast
    hence "l = shd pw # stake n (stl pw)" unfolding stake_def by auto
    thus "l ?R" by (simp add: pw  streams A streams_shd streams_stl)
  qed
  show "?R  ?L"
  proof
    fix l::"'a list"
    assume "l ?R"
    hence " s w. s A  w (stake n `(streams A))  l = s# w" by auto
    from this obtain s and w where "s A" and "w (stake n `(streams A))" and "l = s# w" by blast
      note swprop = this
    have "pw. pw  streams A  w = stake n pw" using swprop by auto
    from this obtain pw where "pw streams A" and "w = stake n pw" by blast note pwprop = this
    have "l  lists A"
    proof -
      have "s A" using swprop by simp
      have "set w  A" using pwprop streams_stake_set by simp
      have "set l = set w  {s}" using swprop by auto
      thus ?thesis using s A ‹set w  A by auto
    qed
    have "x. x  A" using assms by auto
    from this obtain x where "x A" by blast
    let ?sx = "sconst x"
    let ?st = "shift l ?sx"
    have "l = stake (Suc n) ?st" by (simp add: pwprop(2) stake_shift swprop(3))
    have "sset ?sx = {x}" by simp
    hence "sset ?sx  A" using x A by simp
    hence "?sx  streams A" using sset_streams[of "sconst x"] by simp
    hence "?st  streams A" using l  lists A shift_streams[of l A "sconst x"] by simp
    thus "l ?L" using l = stake (Suc n) ?st by blast
  qed
qed


lemma stake_finite_universe_finite:
  assumes "finite A"
  and "A  {}"
  shows "finite (stake n `(streams A))"
proof (induction n)
  let ?L = "(stake 0 `(streams A))"
  have "streams A  {}"
  proof
    assume "streams A = {}"
    have "x. x  A" using assms by auto
    from this obtain x where "x A" by blast
    let ?sx = "sconst x"
    have "sset ?sx = {x}" by simp
    hence "sset ?sx  A" using x A by simp
    hence "?sx  streams A" using sset_streams[of "sconst x"] by simp
    thus False using ‹streams A = {} by simp
  qed
  have "stake 0 = (λs. [])" unfolding stake_def by simp
  hence "?L = {[]}" using ‹streams A  {} by auto
  show "finite (stake 0 `(streams A))" by (simp add: ?L = {[]} image_constant_conv)
next
  fix n assume "finite (stake n `(streams A))" note hyp = this
  have "(stake (Suc n) `(streams A)) = {s#w| s w. s A  w (stake n `(streams A))}" (is "?L = ?R")
  using assms stake_finite_universe_induct[of A n] by simp
  have "finite ?R"  by (simp add: assms(1) finite_image_set2 hyp)
  thus "finite ?L" using ?L = ?Rby simp
qed


lemma  diff_streams_only_if:
  assumes "w  x"
  shows "n. snth w n  snth x n"
proof -
  have f1: "smap (λn. x !! (n - Suc 0)) (fromN (Suc 0))  w"
    by (metis assms stream_smap_fromN)
  obtain nn :: "'a stream  nat stream  (nat  'a)  nat" where
    "x0 x1 x2. (v3. x2 (x1 !! v3)  x0 !! v3) = (x2 (x1 !! nn x0 x1 x2)  x0 !! nn x0 x1 x2)"
    by moura
  then have "x !! (fromN (Suc 0) !! nn w (fromN (Suc 0)) (λn. x !! (n - Suc 0)) - Suc 0)  w !! nn w (fromN (Suc 0)) (λn. x !! (n - Suc 0))"
    using f1 by (meson smap_alt)
  then show ?thesis
    by (metis (no_types) snth_smap stream_smap_fromN)
qed

lemma diff_streams_if:
  assumes "n. snth w n  snth x n"
  shows "w x"
  using assms by auto

lemma sigma_set_union_count:
  assumes " y A. B y  sigma_sets X Y"
and "countable A"
  shows "( y A. B y)  sigma_sets X Y"
  by (metis (mono_tags, lifting) assms countable_image imageE sigma_sets_UNION)

lemma sigma_set_inter_init:
  assumes "i. i(n::nat)  A i  sigma_sets sp B"
and "B  Pow sp"
shows "( i {m. m n}. A i)  sigma_sets sp B"
  by (metis (full_types) assms(1) assms(2) bot.extremum empty_iff mem_Collect_eq sigma_sets_INTER)



lemma  adapt_sigma_sets:
assumes "i. i  n (X i)  measurable M N"
shows "sigma_algebra (space M) (sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets N}))"
proof (rule sigma_algebra_sigma_sets)
  show "(i{m. m  n}. {X i -` A  space M |A. A  sets N})  Pow (space M)"
  proof (rule UN_subset_iff[THEN iffD2], intro ballI)
    fix i
    assume "i  {m. m n}"
    show "{X i -` A  space M |A. A  sets N}  Pow (space M)" by auto
  qed
qed

subsection ‹Bernoulli streams›

text ‹Bernoulli streams represent the formal definition of the infinite coin toss space. The parameter
p› represents the probability of obtaining a head after a coin toss.›

definition bernoulli_stream::"real  (bool stream) measure" where
  "bernoulli_stream p = stream_space (measure_pmf (bernoulli_pmf p))"


lemma bernoulli_stream_space:
  assumes "N = bernoulli_stream p"
  shows "space N = streams UNIV::bool"
using assms unfolding bernoulli_stream_def stream_space_def
by (simp add: assms bernoulli_stream_def space_stream_space)

lemma bernoulli_stream_preimage:
  assumes "N = bernoulli_stream p"
  shows "f -` A  (space N) = f-`A"
using assms by (simp add: bernoulli_stream_space)

lemma  bernoulli_stream_component_probability:
  assumes "N = bernoulli_stream p" and "0  p" and "p  1"
  shows " n. emeasure N {w space N. (snth w n)} = p"
proof
  have "prob_space N" using assms by (simp add: bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
  fix n::nat
  let ?S = "{w space N. (snth w n)}"
  have s: "?S  sets N"
  proof -
    have "(λw. snth w n)  measurable N (measure_pmf (bernoulli_pmf p))" using assms by (simp add: bernoulli_stream_def)
    moreover have "{True}  sets (measure_pmf (bernoulli_pmf p))" by simp
    ultimately show ?thesis by simp
  qed
  let ?PM = "(λi::nat. (measure_pmf (bernoulli_pmf p)))"
  have isps: "product_prob_space ?PM" by unfold_locales
  let ?Z = "{X::natbool. X n = True}"
  let ?wPM = "PiM UNIV ?PM"
  have "space ?wPM = UNIV" using space_PiM by fastforce
  hence "(to_stream -` ?S  (space ?wPM)) = to_stream -` ?S" by simp
  also have "... = ?Z" using assms by (simp add:bernoulli_stream_space to_stream_def)
  also have "... = prod_emb UNIV ?PM {n} (PiE {n} (λx::nat. {True}))"
  proof
    {
      fix X
      assume "X  prod_emb UNIV ?PM {n} (PiE {n} (λx::nat. {True}))"
      hence "restrict X {n}  (PiE {n} (λx::nat. {True}))" using prod_emb_iff[of X] by simp
      hence "X n = True"
        unfolding PiE_iff by auto
      hence "X  ?Z" by simp
    }
    thus "prod_emb UNIV ?PM {n} (PiE {n} (λx::nat. {True}))  ?Z" by auto
    {
      fix X
      assume "X  ?Z"
      hence "X n = True" by simp
      hence "restrict X {n}  (PiE {n} (λx::nat. {True}))"
        unfolding PiE_iff by auto
      moreover have "X  extensional UNIV" by simp
      moreover have "i  UNIV. X i  space (?PM i)" by auto
      ultimately have "X  prod_emb UNIV ?PM {n} (PiE {n} (λx::nat. {True}))" using prod_emb_iff[of X] by simp
    }
    thus "?Z  prod_emb UNIV ?PM {n} (PiE {n} (λx::nat. {True}))" by auto
  qed
  finally have inteq: "(to_stream -` ?S  (space ?wPM)) = prod_emb UNIV ?PM {n} (PiE {n} (λx::nat. {True}))" .
  have "emeasure N ?S = emeasure ?wPM (to_stream -` ?S  (space ?wPM))"
    using assms emeasure_distr[of "to_stream" ?wPM "(vimage_algebra (streams (space (measure_pmf (bernoulli_pmf p)))) (!!)
           (PiM UNIV (λi. measure_pmf (bernoulli_pmf p))))" ?S] measurable_to_stream[of "(measure_pmf (bernoulli_pmf p))"] s
    unfolding bernoulli_stream_def stream_space_def  by auto
  also have "... = emeasure ?wPM (prod_emb UNIV ?PM {n} (PiE {n} (λx::nat. {True})))" using inteq by simp
  also have "... =
    (i{n}. emeasure (?PM i) ((λx::nat. {True}) i))" using isps
    by (auto simp add: product_prob_space.emeasure_PiM_emb simp del: ext_funcset_to_sing_iff)
  also have "... = emeasure (?PM n) {True}" by simp
  also have "... = p" using assms by (simp add: emeasure_pmf_single)
  finally show "emeasure N ?S = p" .
qed


lemma  bernoulli_stream_component_probability_compl:
  assumes "N = bernoulli_stream p" and "0  p" and "p  1"
  shows " n. emeasure N {w space N. ¬(snth w n)} = 1- p"
proof
  fix n
  let ?A = "{w  space N. ¬ w !! n}"
  let ?B = "{w  space N. w !! n}"
  have "?A  ?B = space N" by auto
  have "?A?B = {}" by auto
  hence eqA: "?A = (?A ?B) - ?B" using Diff_cancel by blast
  moreover have "?A  sets N"
  proof -
    have "(λw. snth w n)  measurable N (measure_pmf (bernoulli_pmf p))" using assms by (simp add: bernoulli_stream_def)
    moreover have "{True}  sets (measure_pmf (bernoulli_pmf p))" by simp
    ultimately show ?thesis by simp
  qed
  moreover have "?B  sets N"
  proof -
    have "(λw. snth w n)  measurable N (measure_pmf (bernoulli_pmf p))" using assms by (simp add: bernoulli_stream_def)
    moreover have "{True}  sets (measure_pmf (bernoulli_pmf p))" by simp
    ultimately show ?thesis by simp
  qed
  ultimately have "emeasure N ((?A ?B) - ?B) = emeasure N (?A ?B) - emeasure N ?B"
  proof -
    have f1: "S m. (S::bool stream set)  sets m  emeasure m S =   emeasure m (space m) - emeasure m S = emeasure m (space m - S)"
      by (metis emeasure_compl infinity_ennreal_def)
    have "emeasure N {s  space N. s !! n}  "
      using assms(1) assms(2) assms(3) ennreal_neq_top bernoulli_stream_component_probability by presburger
    then have "emeasure N (space N) - emeasure N {s  space N. s !! n} = emeasure N (space N - {s  space N. s !! n})"
      using f1 {w  space N. w !! n}  sets N by blast
    then show ?thesis
      using {w  space N. ¬ w !! n}  {w  space N. w !! n} = space N by presburger
  qed
  hence "emeasure N ?A = emeasure N (?A ?B) - emeasure N ?B" using eqA by simp
  also have "... = 1 - emeasure N ?B"
    by (metis (no_types, lifting) ?A  ?B = space N assms(1) bernoulli_stream_def
      prob_space.emeasure_space_1 prob_space.prob_space_stream_space prob_space_measure_pmf)
  also have "... = 1 - p" using bernoulli_stream_component_probability[of N p] assms
    by (metis (mono_tags) ennreal_1 ennreal_minus_if)
  finally show "emeasure N ?A = 1 - p" .
qed

lemma bernoulli_stream_sets:
  assumes "0 < q"
  and "q < 1"
  and "0 < p"
  and "p < 1"
shows "sets (bernoulli_stream p) = sets (bernoulli_stream q)" unfolding bernoulli_stream_def
by (rule sets_stream_space_cong, simp)


locale infinite_coin_toss_space =
  fixes p::real and M::"bool stream measure"
  assumes p_gt_0: "0  p"
  and p_lt_1: "p  1"
  and bernoulli: "M = bernoulli_stream p"



sublocale infinite_coin_toss_space  prob_space
by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)

subsection ‹Natural filtration on the infinite coin toss space›

text ‹The natural filtration on the infinite coin toss space is the discrete filtration @{term F}
such that @{term "F n"} represents the restricted measure space in which the outcome of the first
@{term n} coin tosses is known.›

subsubsection ‹The projection function›

text ‹Intuitively, the restricted measure space in which the outcome of the first @{term n} coin tosses is known
can be defined by any measurable function that maps all infinite sequences that agree on the first
@{term n} coin tosses to the same element.›

definition (in infinite_coin_toss_space) pseudo_proj_True:: "nat  bool stream  bool stream" where
  "pseudo_proj_True n  = (λw. shift (stake n w) (sconst True))"

definition (in infinite_coin_toss_space) pseudo_proj_False:: "nat  bool stream  bool stream" where
  "pseudo_proj_False n  = (λw. shift (append (stake n w) [False]) (sconst True))"



lemma (in infinite_coin_toss_space) pseudo_proj_False_neq_True:
  shows "pseudo_proj_False n w  pseudo_proj_True n w"
proof (rule diff_streams_if, intro exI)
  have "snth (pseudo_proj_False n w) n = False" unfolding pseudo_proj_False_def by simp
  moreover have "snth (pseudo_proj_True n w) n = True" unfolding pseudo_proj_True_def by simp
  ultimately show "snth (pseudo_proj_False n w) n  snth (pseudo_proj_True n w) n" by simp
qed


lemma (in infinite_coin_toss_space) pseudo_proj_False_measurable:
  shows "pseudo_proj_False n  measurable (bernoulli_stream p) (bernoulli_stream p)"
proof -
  let ?N = "bernoulli_stream p"
  have "id  measurable ?N ?N" by simp
  moreover have "(λw. (sconst True))  measurable ?N ?N"  using bernoulli_stream_space  by simp
  ultimately show ?thesis using measurable_shift  p_gt_0 p_lt_1
    unfolding bernoulli_stream_def pseudo_proj_False_def by simp
qed

lemma (in infinite_coin_toss_space) pseudo_proj_True_stake:
  shows "stake n (pseudo_proj_True n w) = stake n w" by (simp add: pseudo_proj_True_def stake_shift)

lemma (in infinite_coin_toss_space) pseudo_proj_False_stake:
  shows "stake n (pseudo_proj_False n w) = stake n w" by (simp add: pseudo_proj_False_def stake_shift)

lemma (in infinite_coin_toss_space) pseudo_proj_True_stake_image:
  assumes "(stake n w) = stake n x"
  shows "pseudo_proj_True n w = pseudo_proj_True n x" by (simp add: assms pseudo_proj_True_def)

lemma (in infinite_coin_toss_space) pseudo_proj_True_prefix:
  assumes "n  m"
  and "pseudo_proj_True m x = pseudo_proj_True m y"
  shows "pseudo_proj_True n x = pseudo_proj_True n y"
by (metis assms diff_is_0_eq id_stake_snth_sdrop length_stake pseudo_proj_True_def stake.simps(1) stake_shift)

lemma (in infinite_coin_toss_space) pseudo_proj_True_measurable:
  shows "pseudo_proj_True n  measurable (bernoulli_stream p) (bernoulli_stream p)"
proof -
  let ?N = "bernoulli_stream p"
  have "id  measurable ?N ?N" by simp
  moreover have "(λw. (sconst True))  measurable ?N ?N"  using bernoulli_stream_space  by simp
  ultimately show ?thesis using measurable_shift p_gt_0 p_lt_1
    unfolding bernoulli_stream_def pseudo_proj_True_def by simp
qed

lemma (in infinite_coin_toss_space) pseudo_proj_True_finite_image:
  shows "finite (range (pseudo_proj_True n))"
proof -
  let ?U = "UNIV::bool set"
  have "?U = {True, False}" by auto
  hence "finite ?U"  by simp
  moreover have "?U  {}" by auto
  ultimately have fi: "finite (stake n `streams ?U)" using stake_finite_universe_finite[of ?U] by simp
  let ?sh= "(λl. shift l (sconst True))"
  have "finite {?sh l|l. l(stake n `streams ?U)}" using fi by simp
  moreover have "{?sh l|l. l(stake n `streams ?U)} = range (pseudo_proj_True n)" unfolding pseudo_proj_True_def by auto
  ultimately show ?thesis by simp
qed

lemma (in infinite_coin_toss_space) pseudo_proj_False_finite_image:
  shows "finite (range (pseudo_proj_False n))"
proof -
  let ?U = "UNIV::bool set"
  have "?U = {True, False}" by auto
  hence "finite ?U"  by simp
  moreover have "?U  {}" by auto
  ultimately have fi: "finite (stake n `streams ?U)" using stake_finite_universe_finite[of ?U] by simp
  let ?sh= "(λl. shift (l @ [False]) (sconst True))"
  have "finite {?sh l|l. l(stake n `streams ?U)}" using fi by simp
  moreover have "{?sh l|l. l(stake n `streams ?U)} = range (pseudo_proj_False n)" unfolding pseudo_proj_False_def by auto
  ultimately show ?thesis by simp
qed


lemma (in infinite_coin_toss_space) pseudo_proj_True_proj:
  shows "pseudo_proj_True n (pseudo_proj_True n w) = pseudo_proj_True n w"
by (metis pseudo_proj_True_def pseudo_proj_True_stake)

lemma (in infinite_coin_toss_space) pseudo_proj_True_Suc_False_proj:
  shows "pseudo_proj_True (Suc n) (pseudo_proj_False n w) = pseudo_proj_False n w"
by (metis append_Nil2 cancel_comm_monoid_add_class.diff_cancel length_append_singleton length_stake order_refl pseudo_proj_False_def pseudo_proj_True_def stake.simps(1) stake_shift take_all)



lemma (in infinite_coin_toss_space) pseudo_proj_True_Suc_proj:
  shows "pseudo_proj_True (Suc n) (pseudo_proj_True n w) = pseudo_proj_True n w"
by (metis id_apply id_stake_snth_sdrop pseudo_proj_True_def pseudo_proj_True_stake shift_left_inj siterate.code stake_sdrop stream.sel(2))

lemma (in infinite_coin_toss_space) pseudo_proj_True_proj_Suc:
  shows "pseudo_proj_True n (pseudo_proj_True (Suc n) w) = pseudo_proj_True n w"
by (meson Suc_n_not_le_n nat_le_linear pseudo_proj_True_prefix pseudo_proj_True_stake pseudo_proj_True_stake_image)

lemma (in infinite_coin_toss_space) pseudo_proj_True_shift:
  shows "length l = n  pseudo_proj_True n (shift l (sconst True)) = shift l (sconst True)"
by (simp add: pseudo_proj_True_def stake_shift)


lemma (in infinite_coin_toss_space) pseudo_proj_True_suc_img:
  shows "pseudo_proj_True (Suc n) w  {pseudo_proj_True n w, pseudo_proj_False n w}"
by (metis (full_types) cycle_decomp insertCI list.distinct(1) pseudo_proj_True_def pseudo_proj_False_def sconst_cycle shift_append stake_Suc)



lemma (in infinite_coin_toss_space) measurable_snth_count_space:
  shows "(λw. snth w n)  measurable (bernoulli_stream p) (count_space (UNIV::bool set))"
by (simp add: bernoulli_stream_def)



lemma (in infinite_coin_toss_space) pseudo_proj_True_same_img:
  assumes "pseudo_proj_True n w = pseudo_proj_True n x"
  shows "stake n w = stake n x" by (metis assms pseudo_proj_True_stake)


lemma (in infinite_coin_toss_space) pseudo_proj_True_snth:
  assumes "pseudo_proj_True n x  = pseudo_proj_True n w"
  shows "i. Suc i  n   snth x i = snth w i"
proof -
  fix i
  have "stake n w= stake n x" using assms by (metis pseudo_proj_True_stake)
  assume "Suc i  n"
  thus "snth x i = snth w i" using ‹stake n w = stake n x stake_snth by auto
qed

lemma (in infinite_coin_toss_space) pseudo_proj_True_snth':
  assumes "(i. Suc i  n   snth w i = snth x i)"
  shows "pseudo_proj_True n w  = pseudo_proj_True n x"
proof -
  have "stake n w = stake n x" using stake_snth'[of n w x] using assms by simp
  moreover have "stake n w = stake n x  pseudo_proj_True n w = pseudo_proj_True n x" using pseudo_proj_True_stake_image[of n w x] by simp
  ultimately show ?thesis by auto
qed


lemma (in infinite_coin_toss_space) pseudo_proj_True_preimage:
  assumes "w = pseudo_proj_True n w"
  shows "(pseudo_proj_True n) -` {w} = (i {m. Suc m  n}. (λw. snth w i) -` {snth w i})"
proof
  show "(pseudo_proj_True n) -` {w}  (i{m. Suc m  n}. (λw. snth w i) -` {snth w i})"
  proof
    fix x
    assume "x  (pseudo_proj_True n) -`{w}"
    hence "pseudo_proj_True n x = pseudo_proj_True n w" using assms by auto
    hence "i. i {m. Suc m  n}  x   (λx. snth x i) -`{snth w i}"
      by (metis (mono_tags) Suc_le_eq mem_Collect_eq
      pseudo_proj_True_stake stake_nth vimage_singleton_eq)
    thus "x  (i{m. Suc m  n}. (λw. snth w i) -` {snth w i})" by auto
  qed
  show "(i{m. Suc m  n}. (λw. snth w i) -` {snth w i})  (pseudo_proj_True n) -` {w}"
  proof
    fix x
    assume "x (i{m. Suc m  n}. (λw. snth w i) -` {snth w i})"
    hence "i. i {m. Suc m  n}  x   (λx. snth x i) -`{snth w i}" by simp
    hence "i. i {m. Suc m  n}  snth x i = snth w i" by simp
    hence "i. Suc i  n  snth x i = snth w i" by auto
    hence "pseudo_proj_True n x = pseudo_proj_True n w" using pseudo_proj_True_snth'[of n x w] by simp
    also have "... = w" using assms by simp
    finally have "pseudo_proj_True n x = w" .
    thus "x  (pseudo_proj_True n) -`{w}"  by auto
  qed
qed


lemma (in infinite_coin_toss_space) pseudo_proj_False_preimage:
  assumes "w = pseudo_proj_False n w"
  shows "(pseudo_proj_False n) -` {w} = (i {m. Suc m  n}. (λw. snth w i) -` {snth w i})"
proof
  show "(pseudo_proj_False n) -` {w}  (i{m. Suc m  n}. (λw. snth w i) -` {snth w i})"
  proof
    fix x
    assume "x  (pseudo_proj_False n) -`{w}"
    hence "pseudo_proj_False n x = pseudo_proj_False n w" using assms by auto
    hence "i. i {m. Suc m  n}  x   (λx. snth x i) -`{snth w i}"
      by (metis (mono_tags) Suc_le_eq mem_Collect_eq
      pseudo_proj_False_stake stake_nth vimage_singleton_eq)
    thus "x  (i{m. Suc m  n}. (λw. snth w i) -` {snth w i})" by auto
  qed
  show "(i{m. Suc m  n}. (λw. snth w i) -` {snth w i})  (pseudo_proj_False n) -` {w}"
  proof
    fix x
    assume "x (i{m. Suc m  n}. (λw. snth w i) -` {snth w i})"
    hence "i. i {m. Suc m  n}  x   (λx. snth x i) -`{snth w i}" by simp
    hence "i. i {m. Suc m  n}  snth x i = snth w i" by simp
    hence "i. Suc i  n  snth x i = snth w i" by auto
    hence "pseudo_proj_False n x = pseudo_proj_False n w"
      by (metis (full_types) pseudo_proj_False_def stake_snth')
    also have "... = w" using assms by simp
    finally have "pseudo_proj_False n x = w" .
    thus "x  (pseudo_proj_False n) -`{w}"  by auto
  qed
qed



lemma (in infinite_coin_toss_space) pseudo_proj_True_preimage_stake:
  assumes "w = pseudo_proj_True n w"
  shows "(pseudo_proj_True n) -` {w} = {x. stake n x = stake n w}"
proof
  show "{x. stake n x = stake n w}  (pseudo_proj_True n) -` {w}"
  proof
    fix x
    assume "x  {x. stake n x = stake n w}"
    hence "stake n x = stake n w" by auto
    hence "pseudo_proj_True n x = w" using assms pseudo_proj_True_def by auto
    thus "x  (pseudo_proj_True n) -` {w}" by auto
  qed
  show "(pseudo_proj_True n) -` {w}  {x. stake n x = stake n w}"
  proof
    fix x
    assume "x pseudo_proj_True n -`{w}"
    hence "pseudo_proj_True n x = pseudo_proj_True n w" using assms by auto
    hence "stake n x = stake n w" by (metis pseudo_proj_True_stake)
    thus "x {x. stake n x = stake n w}" by simp
  qed
qed

lemma (in infinite_coin_toss_space) pseudo_proj_False_preimage_stake:
  assumes "w = pseudo_proj_False n w"
  shows "(pseudo_proj_False n) -` {w} = {x. stake n x = stake n w}"
proof
  show "{x. stake n x = stake n w}  (pseudo_proj_False n) -` {w}"
  proof
    fix x
    assume "x  {x. stake n x = stake n w}"
    hence "stake n x = stake n w" by auto
    hence "pseudo_proj_False n x = w" using assms pseudo_proj_False_def by auto
    thus "x  (pseudo_proj_False n) -` {w}" by auto
  qed
  show "(pseudo_proj_False n) -` {w}  {x. stake n x = stake n w}"
  proof
    fix x
    assume "x pseudo_proj_False n -`{w}"
    hence "pseudo_proj_False n x = pseudo_proj_False n w" using assms by auto
    hence "stake n x = stake n w" by (metis pseudo_proj_False_stake)
    thus "x {x. stake n x = stake n w}" by simp
  qed
qed


lemma (in infinite_coin_toss_space) pseudo_proj_True_preimage_stake_space:
  assumes "w = pseudo_proj_True n w"
  shows "(pseudo_proj_True n) -` {w}  space M = {x space M. stake n x = stake n w}"
proof -
  have "(pseudo_proj_True n) -` {w} = {x. stake n x = stake n w}" using assms
    by (simp add:pseudo_proj_True_preimage_stake)
  hence "(pseudo_proj_True n) -` {w} space M = {x. stake n x = stake n w} space M"
    by simp
  also have "... = {x space M. stake n x = stake n w}" by auto
  finally show ?thesis .
qed

lemma (in infinite_coin_toss_space) pseudo_proj_True_singleton:
  assumes "w = pseudo_proj_True n w"
  shows "(pseudo_proj_True n) -`{w}  (space (bernoulli_stream p))  sets (bernoulli_stream p)"
proof (cases "{m. (Suc m)  n} = {}")
case False
  have "i. (λx. snth x i)  measurable (bernoulli_stream p) (count_space UNIV)" by (simp add: measurable_snth_count_space)
  have fi: "i. Suc i  n  (λw. snth w i) -` {snth w i}  (space (bernoulli_stream p))  sets (bernoulli_stream p)"
  proof -
    fix i
    assume "Suc i  n"
    have "(λx. snth x i)  measurable (bernoulli_stream p) (count_space UNIV)" by (simp add: measurable_snth_count_space)
    moreover have "{snth w i}  sets (count_space UNIV)" by auto
    ultimately show "(λx. snth x i) -` {snth w i} (space (bernoulli_stream p))  sets (bernoulli_stream p)"
      unfolding measurable_def by (simp add: measurable_snth_count_space)
  qed
  have "(i {m. (Suc m)  n}. (λw. snth w i) -` {snth w i} (space (bernoulli_stream p)))  sets (bernoulli_stream p)"
  proof ((rule sigma_algebra.countable_INT''), auto)
    show "sigma_algebra (space (bernoulli_stream p)) (sets (bernoulli_stream p))"
      using measure_space measure_space_def by auto
    show "UNIV  sets (bernoulli_stream p)" by (metis bernoulli_stream_space sets.top streams_UNIV)
    show "i. Suc i  n  (λw. w !! i) -` {w !! i}  space (bernoulli_stream p)  sets (bernoulli_stream p)" using fi by simp
  qed
  moreover have "(i {m. (Suc m)  n}. (λw. snth w i) -` {snth w i} (space (bernoulli_stream p))) =
    (i {m. (Suc m)  n}. (λw. snth w i) -` {snth w i}) (space (bernoulli_stream p))"
    using False Inter_nonempty_distrib by auto
  ultimately show ?thesis using assms pseudo_proj_True_preimage[of w n] by simp
next
case True
  hence "n = 0" using less_eq_Suc_le by auto
  hence "pseudo_proj_True n = (λw. sconst True)" by (simp add: pseudo_proj_True_def)
  hence "w = sconst True" using assms by simp
  hence "(pseudo_proj_True n) -`{w}  (space (bernoulli_stream p)) = (space (bernoulli_stream p))" by (simp add: ‹pseudo_proj_True n = (λw. sconst True))
  thus "(pseudo_proj_True n) -`{w}  (space (bernoulli_stream p)) sets (bernoulli_stream p)" by simp
qed


lemma (in infinite_coin_toss_space) pseudo_proj_False_singleton:
  assumes "w = pseudo_proj_False n w"
  shows "(pseudo_proj_False n) -`{w}  (space (bernoulli_stream p))  sets (bernoulli_stream p)"
proof (cases "{m. (Suc m)  n} = {}")
case False
  have "i. (λx. snth x i)  measurable (bernoulli_stream p) (count_space UNIV)" by (simp add: measurable_snth_count_space)
  have fi: "i. Suc i  n  (λw. snth w i) -` {snth w i}  (space (bernoulli_stream p))  sets (bernoulli_stream p)"
  proof -
    fix i
    assume "Suc i  n"
    have "(λx. snth x i)  measurable (bernoulli_stream p) (count_space UNIV)" by (simp add: measurable_snth_count_space)
    moreover have "{snth w i}  sets (count_space UNIV)" by auto
    ultimately show "(λx. snth x i) -` {snth w i} (space (bernoulli_stream p))  sets (bernoulli_stream p)"
      unfolding measurable_def by (simp add: measurable_snth_count_space)
  qed
  have "(i {m. (Suc m)  n}. (λw. snth w i) -` {snth w i} (space (bernoulli_stream p)))  sets (bernoulli_stream p)"
  proof ((rule sigma_algebra.countable_INT''), auto)
    show "sigma_algebra (space (bernoulli_stream p)) (sets (bernoulli_stream p))"
      using measure_space measure_space_def by auto
    show "UNIV  sets (bernoulli_stream p)" by (metis bernoulli_stream_space sets.top streams_UNIV)
    show "i. Suc i  n  (λw. w !! i) -` {w !! i}  space (bernoulli_stream p)  sets (bernoulli_stream p)" using fi by simp
  qed
  moreover have "(i {m. (Suc m)  n}. (λw. snth w i) -` {snth w i} (space (bernoulli_stream p))) =
    (i {m. (Suc m)  n}. (λw. snth w i) -` {snth w i}) (space (bernoulli_stream p))"
    using False Inter_nonempty_distrib by auto
  ultimately show ?thesis using assms pseudo_proj_False_preimage[of w n] by simp
next
case True
  hence "n = 0" using less_eq_Suc_le by auto
  hence "pseudo_proj_False n = (λw. False ## sconst True)" by (simp add: pseudo_proj_False_def)
  hence "w = False ## sconst True" using assms by simp
  hence "(pseudo_proj_False n) -`{w}  (space (bernoulli_stream p)) = (space (bernoulli_stream p))"
    by (simp add: ‹pseudo_proj_False n = (λw. False##sconst True))
  thus "(pseudo_proj_False n) -`{w}  (space (bernoulli_stream p)) sets (bernoulli_stream p)" by simp
qed

lemma (in infinite_coin_toss_space) pseudo_proj_True_inverse_induct:
  assumes "w  range (pseudo_proj_True n)"
  shows "(pseudo_proj_True n) -` {w} =
    (pseudo_proj_True (Suc n)) -` {w}  (pseudo_proj_True (Suc n)) -`{pseudo_proj_False n w}"
proof
  let ?y = "pseudo_proj_False n w"
  show "(pseudo_proj_True n) -` {w}  (pseudo_proj_True (Suc n)) -` {w}  (pseudo_proj_True (Suc n)) -`{?y}"
  proof
    fix z
    assume "z pseudo_proj_True n -`{w}"
    thus "z pseudo_proj_True (Suc n) -`{w}  pseudo_proj_True (Suc n) -`{?y}"
      using pseudo_proj_False_def pseudo_proj_True_def pseudo_proj_True_stake
      pseudo_proj_True_suc_img by fastforce
  qed
  {
    fix z
    assume "z  pseudo_proj_True (Suc n) -` {w}"
    hence "pseudo_proj_True (Suc n) z = w" by simp
    hence "pseudo_proj_True n z = pseudo_proj_True n w" by (metis  pseudo_proj_True_proj_Suc)
    also have "... = w" using assms pseudo_proj_True_def pseudo_proj_True_stake by auto
    finally have "pseudo_proj_True n z = w" .
  }
  hence fst: "pseudo_proj_True (Suc n) -` {w}  (pseudo_proj_True n) -` {w}" by blast
  {
    fix z
    assume "z  pseudo_proj_True (Suc n) -` {?y}"
    hence "pseudo_proj_True n z = pseudo_proj_True n w"
      by (metis append1_eq_conv append_Nil2 cancel_comm_monoid_add_class.diff_cancel
        length_append_singleton length_stake order_refl pseudo_proj_False_def
        pseudo_proj_True_stake pseudo_proj_True_stake_image stake_Suc stake_invert_Nil stake_shift
        take_all vimage_singleton_eq)

    also have "... = w" using assms pseudo_proj_True_def pseudo_proj_True_stake by auto
    finally have "pseudo_proj_True n z = w" .
  }
  hence scd: "pseudo_proj_True (Suc n) -` {?y}  (pseudo_proj_True n) -` {w}" by blast
  show "(pseudo_proj_True (Suc n)) -` {w}  (pseudo_proj_True (Suc n)) -`{?y}  (pseudo_proj_True n) -` {w}"
    using fst scd by auto
qed




subsubsection ‹Natural filtration locale›

text ‹This part is mainly devoted to the proof that the projection function defined above indeed
permits to obtain a filtration on the infinite coin toss space, and that this filtration is initially trivial.›

definition (in infinite_coin_toss_space) nat_filtration::"nat  bool stream measure" where
  "nat_filtration n = fct_gen_subalgebra M M (pseudo_proj_True n)"




locale infinite_cts_filtration = infinite_coin_toss_space +
  fixes F
  assumes natural_filtration: "F = nat_filtration"


lemma (in infinite_coin_toss_space) nat_filtration_space:
  shows "space (nat_filtration n) = UNIV"
by (metis bernoulli bernoulli_stream_space fct_gen_subalgebra_space nat_filtration_def streams_UNIV)

lemma (in infinite_coin_toss_space) nat_filtration_sets:
  shows "sets (nat_filtration n) =
    sigma_sets (space (bernoulli_stream p))
            {pseudo_proj_True n -` B  space M |B. B  sets (bernoulli_stream p)}"
proof -
  have "sigma_sets (space M) {pseudo_proj_True n -` S  space M |S. S  sets (bernoulli_stream p)} =
    sets (fct_gen_subalgebra M M (pseudo_proj_True n))"
    using bernoulli fct_gen_subalgebra_sets pseudo_proj_True_measurable by blast
  then show ?thesis
    using bernoulli nat_filtration_def by force
qed


lemma (in infinite_coin_toss_space) nat_filtration_singleton:
  assumes "pseudo_proj_True n w = w"
  shows "pseudo_proj_True n -`{w}  sets (nat_filtration n)"
proof -
  let ?pw = "pseudo_proj_True n -`{w}"
  have memset:"?pw  sets M" using bernoulli assms bernoulli_stream_preimage[of _ _ "pseudo_proj_True n"]
      pseudo_proj_True_singleton[of w n] by simp
  have "pseudo_proj_True n -`?pw  sets (nat_filtration n)"
  proof -
    have "pseudo_proj_True n -`?pw  (space M)  sets (nat_filtration n)" using memset
      by (metis fct_gen_subalgebra_sets_mem nat_filtration_def)
    moreover have "pseudo_proj_True n -`?pw  (space M) = pseudo_proj_True n -`?pw" using
      bernoulli_stream_preimage[of _ _ "pseudo_proj_True n"] bernoulli by simp
    ultimately show "pseudo_proj_True n -`?pw  sets (nat_filtration n)"  by auto
  qed
  moreover have "pseudo_proj_True n -`?pw = ?pw" using pseudo_proj_True_proj by auto
  ultimately show ?thesis by simp
qed



lemma (in infinite_coin_toss_space) nat_filtration_pseudo_proj_True_measurable:
  shows "pseudo_proj_True n  measurable (nat_filtration n) M" unfolding nat_filtration_def
using bernoulli fct_gen_subalgebra_fct_measurable[of "pseudo_proj_True n" M M]  pseudo_proj_True_measurable[of n]
  bernoulli_stream_space by auto



lemma (in infinite_coin_toss_space) nat_filtration_comp_measurable:
  assumes "f  measurable M N"
  and "f  pseudo_proj_True n = f"
  shows "f  measurable (nat_filtration n) N"
by (metis assms measurable_comp nat_filtration_pseudo_proj_True_measurable)

definition (in infinite_coin_toss_space) set_discriminating where
"set_discriminating n f N  (w. f w  f (pseudo_proj_True n w) 
  (Asets N. (f w  A) = (f (pseudo_proj_True n w)  A)))"

lemma (in infinite_coin_toss_space) set_discriminating_if:
  fixes f::"bool stream  'b::{t0_space}"
  assumes "f borel_measurable (nat_filtration n)"
  shows "set_discriminating n f borel" unfolding set_discriminating_def
proof (intro allI impI)
  {
    fix w
    assume "f w  (f  (pseudo_proj_True n)) w"
    hence "U. open U  ( f w  U = ((f  (pseudo_proj_True n)) w  U))" using separation_t0 by auto
    from this obtain A where "open A" and "f w A = ((f  (pseudo_proj_True n)) w  A)" by blast note Ah = this
    have "A sets borel" using Ah by simp
    hence "Asets borel. (f w  A) = ((f  (pseudo_proj_True n)) w  A)" using Ah by blast
  }
  thus "w. f w  f (pseudo_proj_True n w)  Asets borel. (f w  A) = (f (pseudo_proj_True n w)  A)"  by simp
qed

lemma (in infinite_coin_toss_space) nat_filtration_not_borel_info:
  assumes "f measurable (nat_filtration n) N"
  and "set_discriminating n f N"
  shows "f pseudo_proj_True n = f"
proof (rule ccontr)
  assume "f pseudo_proj_True n  f"
  hence " w. (f (pseudo_proj_True n)) w  f w" by auto
  from this obtain w where "(f (pseudo_proj_True n)) w  f w" by blast note wh = this
  let ?x = "pseudo_proj_True n w"
  have "pseudo_proj_True n ?x = pseudo_proj_True n w" by (simp add: pseudo_proj_True_proj)
  have "f w  f (pseudo_proj_True n w)" using wh by simp
  hence "A  sets N. ( f w  A = (f ?x  A))" using assms  unfolding set_discriminating_def by simp
  from this obtain A where "A  sets N" and "f w A = (f ?x  A)" by blast note Ah = this
  have "f-` A (space (nat_filtration n))  sets (nat_filtration n)"
    using Ah assms borel_open measurable_sets by blast
  hence fn:"f-` A  sets (nat_filtration n)" using nat_filtration_space by simp
  have "?x f-`A = (w  f -`A)" using ‹pseudo_proj_True n ?x = pseudo_proj_True n w assms
    fct_gen_subalgebra_info[of "pseudo_proj_True n" M] bernoulli_stream_space
    by (metis Pi_I UNIV_I bernoulli fn nat_filtration_def streams_UNIV)
  also have "... = (f w  A)" by simp
  also have "... = (f ?x  A)" using Ah by simp
  also have "... = (?x  f -`A)" by simp
  finally have "?x f-`A = (?x  f -`A)" .
  thus False by simp
qed




lemma (in infinite_coin_toss_space) nat_filtration_info:
  fixes f::"bool stream  'b::{t0_space}"
  assumes "f borel_measurable (nat_filtration n)"
  shows "f pseudo_proj_True n = f"
proof (rule nat_filtration_not_borel_info)
  show "f borel_measurable (nat_filtration n)" using assms by simp
  show "set_discriminating n f borel" using assms by (simp add: set_discriminating_if)
qed





lemma (in infinite_coin_toss_space) nat_filtration_not_borel_info':
  assumes "f measurable (nat_filtration n) N"
  and "set_discriminating n f N"
  shows "f pseudo_proj_False n = f"
proof
  fix x
  have "(f  pseudo_proj_False n) x = f (pseudo_proj_False n x)" by simp
  also have "... = f (pseudo_proj_True n (pseudo_proj_False n x))" using assms nat_filtration_not_borel_info
    by (metis comp_apply)
  also have "... = f (pseudo_proj_True n x)"
  proof -
    have "pseudo_proj_True n (pseudo_proj_False n x) = pseudo_proj_True n x"
      by (simp add: pseudo_proj_False_stake pseudo_proj_True_def)
    thus ?thesis by simp
  qed
  also have "... = f x" using assms nat_filtration_not_borel_info by (metis comp_apply)
  finally show "(f  pseudo_proj_False n) x = f x" .
qed

lemma (in infinite_coin_toss_space) nat_filtration_info':
  fixes f::"bool stream  'b::{t0_space}"
  assumes "f borel_measurable (nat_filtration n)"
  shows "f pseudo_proj_False n = f"
proof
  fix x
  have "(f  pseudo_proj_False n) x = f (pseudo_proj_False n x)" by simp
  also have "... = f (pseudo_proj_True n (pseudo_proj_False n x))" using assms nat_filtration_info
    by (metis comp_apply)
  also have "... = f (pseudo_proj_True n x)"
  proof -
    have "pseudo_proj_True n (pseudo_proj_False n x) = pseudo_proj_True n x"
      by (simp add: pseudo_proj_False_stake pseudo_proj_True_def)
    thus ?thesis by simp
  qed
  also have "... = f x" using assms nat_filtration_info by (metis comp_apply)
  finally show "(f  pseudo_proj_False n) x = f x" .
qed



lemma (in infinite_coin_toss_space) nat_filtration_borel_measurable_characterization:
  fixes f::"bool stream  'b::{t0_space}"
  assumes "f borel_measurable M"
  shows "f borel_measurable (nat_filtration n)  f pseudo_proj_True n = f"
using assms nat_filtration_comp_measurable nat_filtration_info by blast




lemma (in infinite_coin_toss_space) nat_filtration_borel_measurable_init:
  fixes f::"bool stream  'b::{t0_space}"
  assumes "f borel_measurable (nat_filtration 0)"
  shows "f = (λw. f (sconst True))"
proof
  fix w
  have "f w = f ((pseudo_proj_True 0) w)" using assms nat_filtration_info[of f 0] by (metis comp_apply)
  also have "... = f (sconst True)" by (simp add: pseudo_proj_True_def)
  finally show "f w = f (sconst True)" .
qed




lemma (in infinite_coin_toss_space) nat_filtration_Suc_sets:
  shows "sets (nat_filtration n)  sets (nat_filtration (Suc n))"
proof -
  {
    fix x
    assume "x {pseudo_proj_True n -` B  space M |B. B  sets M}"
    hence "B. B  sets M  x = pseudo_proj_True n -` B  space M" by auto
    from this obtain B where "B  sets M" and "x = pseudo_proj_True n -` B  space M"
      by blast note xhyps = this
      let ?Bim = "B (range (pseudo_proj_True n))"
      let ?preT = "(λn w. (pseudo_proj_True n) -` {w})"
      have "finite ?Bim" using pseudo_proj_True_finite_image by simp
      have "pseudo_proj_True n -`B  (space M) = pseudo_proj_True n -`B"
        using bernoulli bernoulli_stream_preimage[of _ _ "pseudo_proj_True n"] by simp
      also have "... = pseudo_proj_True n -`?Bim" by auto
      also have "... = ( w  ?Bim.?preT n w)" by auto
      also have "... = ( w  ?Bim. (?preT (Suc n) w  ?preT (Suc n) (pseudo_proj_False n w)))"
        by (simp add:pseudo_proj_True_inverse_induct)
      also have "... = ( w  ?Bim. ?preT (Suc n) w)  ( w  ?Bim. ?preT (Suc n) (pseudo_proj_False n w))" by auto
      finally have tmpeq: "pseudo_proj_True n -`B  (space M) =
        ( w  ?Bim. ?preT (Suc n) w)  ( w  ?Bim. ?preT (Suc n) (pseudo_proj_False n w))" .
      have "( w  ?Bim. ?preT (Suc n) w)  sets (nat_filtration (Suc n))"
        using ‹finite ?Bim nat_filtration_singleton pseudo_proj_True_Suc_proj by auto
      moreover have "( w  ?Bim. ?preT (Suc n) (pseudo_proj_False n w))  sets (nat_filtration (Suc n))" using ‹finite ?Bim
        by (simp add: nat_filtration_singleton pseudo_proj_True_Suc_False_proj sets.finite_UN)
      ultimately have "x  sets (nat_filtration (Suc n))"
        using tmpeq xhyps by simp
  } note xmem = this
  have "sets (nat_filtration n) = sigma_sets (space M) {pseudo_proj_True n -` B  space M |B. B  sets M}"
    using bernoulli nat_filtration_sets by blast
  also have "...  (nat_filtration (Suc n))"
  proof (rule sigma_algebra.sigma_sets_subset)
    show "{pseudo_proj_True n -` B  space M |B. B  sets M}
       sets (nat_filtration (Suc n))" using xmem by auto
    show "sigma_algebra (space M) (sets (nat_filtration (Suc n)))"
      by (metis bernoulli bernoulli_stream_space nat_filtration_space sets.sigma_algebra_axioms streams_UNIV)
  qed
  finally show ?thesis .
qed

lemma (in infinite_coin_toss_space) nat_filtration_subalgebra:
  shows "subalgebra M (nat_filtration n)" using bernoulli fct_gen_subalgebra_is_subalgebra nat_filtration_def
      pseudo_proj_True_measurable by metis

lemma (in infinite_coin_toss_space) nat_discrete_filtration:
  shows "filtration M nat_filtration"
  unfolding filtration_def
proof((intro conjI), (intro allI)+)
  {
    fix n
    let ?F = "nat_filtration n"
    show "subalgebra M ?F"
      using bernoulli fct_gen_subalgebra_is_subalgebra nat_filtration_def
      pseudo_proj_True_measurable by metis
  } note allrm = this
  show "n m. n  m  subalgebra (nat_filtration m) (nat_filtration n)"
  proof (intro allI impI)
    let ?F = nat_filtration
    fix n::nat
    fix m
    show "n  m  subalgebra (nat_filtration m) (nat_filtration n)"
    proof (induct m)
      case (Suc m)
      have "subalgebra (?F (Suc m)) (?F m)" unfolding subalgebra_def
      proof (intro conjI)
        show speq: "space (?F m) = space (?F (Suc m))" by (simp add: nat_filtration_space)
        show "sets (?F m)  sets (?F (Suc m))" using nat_filtration_Suc_sets by simp
      qed

      thus "n  Suc m  subalgebra (?F (Suc m)) (?F n)" using Suc
        using Suc.hyps le_Suc_eq subalgebra_def by fastforce
      next
      case 0
        thus ?case by (simp add: subalgebra_def)
    qed
  qed
qed

lemma (in infinite_coin_toss_space) nat_info_filtration:
  shows "init_triv_filt M nat_filtration" unfolding init_triv_filt_def
proof
  show "filtration M nat_filtration" by (simp add:nat_discrete_filtration)
  have img: " w space M. pseudo_proj_True 0 w = sconst True" unfolding pseudo_proj_True_def by simp
  show "sets (nat_filtration bot) = {{}, space M}"
  proof
    show "{{}, space M}  sets (nat_filtration bot)"
      by (metis empty_subsetI insert_subset nat_filtration_subalgebra sets.empty_sets sets.top subalgebra_def)
    show "sets (nat_filtration bot)  {{}, space M}"
    proof -
      have "B  sets (bernoulli_stream p). pseudo_proj_True 0 -` B  space M  {{}, space M}"
      proof
        fix B
        assume "B  sets (bernoulli_stream p)"
        show "pseudo_proj_True 0 -` B  space M  {{}, space M}"
        proof (cases "sconst True  B")
          case True
          hence "pseudo_proj_True 0 -` B  space M = space M" using img by auto
          thus ?thesis by auto
        next
          case False
          hence "pseudo_proj_True 0 -` B  space M = {}" using img by auto
          thus ?thesis by auto
        qed
      qed
      hence "{pseudo_proj_True 0 -` B  space M |B. B  sets (bernoulli_stream p)}  {{}, space M}" by auto
      hence "sigma_sets (space (bernoulli_stream p))
            {pseudo_proj_True 0 -` B  space M |B. B  sets (bernoulli_stream p)}  {{}, space M}"
        using sigma_algebra.sigma_sets_subset[of "space (bernoulli_stream p)" "{{}, space M}"]
        by (simp add: bernoulli sigma_algebra_trivial)
      thus ?thesis by (simp add:nat_filtration_sets bot_nat_def)
    qed
  qed
qed



sublocale infinite_cts_filtration  triv_init_disc_filtr_prob_space
proof (unfold_locales, intro conjI)
  show "disc_filtr M F" unfolding disc_filtr_def
    using filtrationE2 nat_discrete_filtration nat_filtration_subalgebra natural_filtration by auto
  show "sets (F bot) = {{}, space M}" using nat_info_filtration natural_filtration
    unfolding init_triv_filt_def by simp
qed





lemma (in infinite_coin_toss_space) nat_filtration_vimage_finite:
  fixes f::"bool stream  'b::{t2_space}"
  assumes "f borel_measurable (nat_filtration n)"
  shows "finite (f`(space M))" using pseudo_proj_True_finite_image nat_filtration_info[of f n]
    by (metis assms bernoulli bernoulli_stream_space finite_imageI fun.set_map streams_UNIV)

lemma (in infinite_coin_toss_space) nat_filtration_borel_measurable_simple:
  fixes f::"bool stream  'b::{t2_space}"
  assumes "f borel_measurable (nat_filtration n)"
  shows "simple_function M f"
proof -
  have f1: "m ma. (m::bool stream measure) M (ma::'b measure) = {f  space m  space ma. B. B  sets ma  f -` B  space m  sets m}"
    by (metis measurable_def)
  then have "f  space (nat_filtration n)  space borel  (B. B  sets borel  f -` B  space (nat_filtration n)  sets (nat_filtration n))"
    using assms by blast
  then have "f  space M  space borel  (B. B  sets borel  f -` B  space M  events)"
    by (metis (no_types) contra_subsetD nat_filtration_subalgebra subalgebra_def)
  then have "random_variable borel f"
    using f1 by blast
  then show ?thesis
    using assms nat_filtration_vimage_finite simple_function_borel_measurable by blast
qed


lemma (in infinite_coin_toss_space) nat_filtration_singleton_range_set:
  fixes f::"bool stream  'b::{t2_space}"
  assumes "f borel_measurable (nat_filtration n)"
  shows " A sets borel. range f  A = {f x}"
proof -
  let ?Ax = "range f - {f x}"
  have "range f = f`space M" using bernoulli bernoulli_stream_space by simp
  hence "finite ?Ax" using assms nat_filtration_vimage_finite by auto
  hence "U. open U  f x U  U ?Ax = {}" by (simp add:open_except_set)
  then obtain U where "open U" and "f x U" and "U ?Ax = {}" by auto
  have "U  sets borel" using ‹open U by simp
  have "range f  U = {f x}" using f x  U U ?Ax = {} by blast
  thus "A sets borel. range f  A = {f x}" using U sets borel› by auto
qed

lemma (in infinite_coin_toss_space) nat_filtration_borel_measurable_singleton:
  fixes f::"bool stream  'b::{t2_space}"
  assumes "f borel_measurable (nat_filtration n)"
  shows "f -`{f x}  sets (nat_filtration n)"
proof -
  let ?Ax = "f`space M - {f x}"
  have "finite ?Ax"
    using assms nat_filtration_vimage_finite by blast
  hence "U. open U  f x U  U ?Ax = {}" by (simp add:open_except_set)
  then obtain U where "open U" and "f x U" and "U ?Ax = {}" by auto
  have "f x  f ` space M" using bernoulli_stream_space bernoulli by simp
  hence "f`space M  U = {f x}" using f x U U ?Ax = {} by blast
  hence "A. open A f`space M  A = {f x}" using ‹open U by auto
  from this obtain A where "open A" and inter: "f`space M  A = {f x}" by auto
  have "A  sets borel" using ‹open A by simp
  hence "f -`A  space M  sets (nat_filtration n)" using assms nat_filtration_space
    by (simp add: bernoulli bernoulli_stream_space in_borel_measurable_borel)
  hence "f -`A  space M  events" using nat_filtration_subalgebra
    by (meson subalgebra_def subset_eq)
  have "f -`{f x} space M  = f -`A space M"
  proof
    have "f x A" using inter by auto
    thus "f -` {f x} space M  f -` A space M" by auto
    show "f -` A space M  f -` {f x} space M"
    proof
      fix y
      assume "y f-` A space M"
      hence  "f y  A f`space M" by simp
      hence "f y = f x" using inter by auto
      thus "y f -` {f x} space M" using y f-` A space M by auto
    qed
  qed
  moreover have "f -`A  space M  (nat_filtration n)" using assms A sets borel›
    using f -` A  space M  sets (nat_filtration n) by blast
  ultimately show ?thesis using bernoulli_stream_space bernoulli by simp
qed

lemma (in infinite_cts_filtration) borel_adapt_nat_filtration_info:
  fixes X::"nat  bool stream  'b::{t0_space}"
  assumes "borel_adapt_stoch_proc F X"
  and "m  n"
shows "X m (pseudo_proj_True n w) = X m w"
proof -
  have "X m  borel_measurable (F n)" using assms natural_filtration
    using  increasing_measurable_info
    by (metis adapt_stoch_proc_def)
  thus ?thesis using nat_filtration_info natural_filtration
    by (metis comp_apply)
qed

lemma (in infinite_coin_toss_space) nat_filtration_borel_measurable_integrable:
  assumes "f borel_measurable (nat_filtration n)"
  shows "integrable M f"
proof -
  have "simple_function M f" using assms by (simp add: nat_filtration_borel_measurable_simple)
  moreover have "emeasure M {y  space M. f y  0}  " by simp
  ultimately have "Bochner_Integration.simple_bochner_integrable M f"
    using Bochner_Integration.simple_bochner_integrable.simps by blast
  hence "has_bochner_integral M f (Bochner_Integration.simple_bochner_integral M f)"
    using has_bochner_integral_simple_bochner_integrable by auto
  thus ?thesis using integrable.simps by auto
qed




definition (in infinite_coin_toss_space) spick:: "bool stream  nat  bool  bool stream" where
  "spick w n v = shift (stake n w) (v## sconst True)"


lemma (in infinite_coin_toss_space) spickI:
  shows "stake n (spick w n v) = stake n w  snth (spick w n v) n = v"
by (simp add: spick_def stake_shift)

lemma (in infinite_coin_toss_space) spick_eq_pseudo_proj_True:
  shows "spick w n True = pseudo_proj_True n w" unfolding spick_def pseudo_proj_True_def
  by (metis (full_types) id_apply siterate.code)

lemma (in infinite_coin_toss_space) spick_eq_pseudo_proj_False:
  shows "spick w n False = pseudo_proj_False n w" unfolding spick_def pseudo_proj_False_def by simp


lemma (in infinite_coin_toss_space) spick_pseudo_proj:
  shows "spick (pseudo_proj_True (Suc n) w) n v = spick w n v"
      by (metis pseudo_proj_True_proj_Suc pseudo_proj_True_stake spick_def)

lemma (in infinite_coin_toss_space) spick_pseudo_proj_gen:
  shows "m < n  spick (pseudo_proj_True n w) m v = spick w m v"
by (metis Suc_leI pseudo_proj_True_proj pseudo_proj_True_prefix spick_pseudo_proj)


lemma (in infinite_coin_toss_space) spick_nat_filtration_measurable:
  shows "(λw. spick w n v)  measurable (nat_filtration n) M"
proof (rule nat_filtration_comp_measurable)
  show "(λw. spick w n v)  measurable M M"
  proof -
    let ?N = "bernoulli_stream p"
    have "id  measurable ?N ?N" by simp
    moreover have "(λw. v## (sconst True))  measurable ?N ?N"  using bernoulli_stream_space  by simp
    ultimately show ?thesis using measurable_shift bernoulli p_gt_0 p_lt_1
      unfolding bernoulli_stream_def spick_def by simp
  qed
  {
    fix w
    have "spick (pseudo_proj_True n w) n v = spick w n v"
      by (simp add: pseudo_proj_True_stake spick_def)
  }
  thus "(λw. spick w n v)  pseudo_proj_True n = (λw. spick w n v)" by auto
qed


definition (in infinite_coin_toss_space) proj_rep_set:
  "proj_rep_set n = range (pseudo_proj_True n)"

lemma (in infinite_coin_toss_space) proj_rep_set_finite:
  shows "finite (proj_rep_set n)" using pseudo_proj_True_finite_image
  by (simp add: proj_rep_set)


lemma (in infinite_coin_toss_space) set_filt_contain:
  assumes "A sets (nat_filtration n)"
and "w A"
shows "pseudo_proj_True n -` {pseudo_proj_True n w}  A"
proof
  define indA where "indA = ((indicator A)::bool streamreal)"
  have "indA  borel_measurable (nat_filtration n)" unfolding indA_def
    by (simp add: assms(1) borel_measurable_indicator)
  fix x
  assume "x  pseudo_proj_True n -` {pseudo_proj_True n w}"
  have "indA x = indA (pseudo_proj_True n x)"
    using nat_filtration_info[symmetric, of "indicator A" n] indA  borel_measurable (nat_filtration n)
    unfolding indA_def by (metis comp_apply)
  also have "... = indA (pseudo_proj_True n w)" using x  pseudo_proj_True n -` {pseudo_proj_True n w}
    by simp
  also have "... = indA w" using nat_filtration_info[of "indicator A" n]
    indA  borel_measurable (nat_filtration n) unfolding indA_def by (metis comp_apply)
  also have "... = 1" using assms unfolding indA_def by simp
  finally have "indA x = 1" .
  thus "x A" unfolding indA_def by (simp add: indicator_eq_1_iff)
qed




lemma (in infinite_cts_filtration) measurable_range_rep:
  fixes f::"bool stream  'b::{t0_space}"
  assumes "f  borel_measurable (nat_filtration n)"
  shows "range f = ( r(proj_rep_set n). {f(r)})"
proof -
  have "f = f  (pseudo_proj_True n)" using assms nat_filtration_info[of f n] by simp
  hence "range f = f `(proj_rep_set n)" by (metis fun.set_map proj_rep_set)
  also have "... = (rproj_rep_set n. {f r})" by blast
  finally show "range f = (rproj_rep_set n. {f r})" .
qed

lemma (in infinite_coin_toss_space) borel_measurable_stake:
  fixes f::"bool stream  'b::{t0_space}"
  assumes "f borel_measurable (nat_filtration n)"
  and "stake n w = stake n y"
shows "f w = f y"
proof -
  have "pseudo_proj_True n w = pseudo_proj_True n y" unfolding pseudo_proj_True_def using assms by simp
  thus ?thesis using assms nat_filtration_info by (metis comp_apply)
qed





subsubsection ‹Probability component›

text ‹The probability component permits to compute measures of subspaces in a straightforward way.›

definition  prob_component where
  "prob_component (p::real) w n = (if (snth w n) then p else 1-p)"

lemma  prob_component_neq_zero:
  assumes "0 < p"
and "p < 1"
  shows "prob_component p w n  0" using assms prob_component_def by auto

lemma  prob_component_measure:
  fixes x::"bool stream"
assumes "0  p"
and "p  1"
  shows "emeasure (measure_pmf (bernoulli_pmf p)) {snth x i} = prob_component p x i"  unfolding prob_component_def using emeasure_pmf_single
    pmf_bernoulli_False pmf_bernoulli_True
  by (simp add: emeasure_pmf_single assms)



lemma  stake_preimage_measurable:
  fixes x::"bool stream"
  assumes "Suc 0  n" and "M = bernoulli_stream p"
  shows "{w space M. (stake n w = stake n x)}  sets M"
proof -
  let ?S =  "{w space M. (stake n w = stake n x)}"
  have "?S = ( i  {0.. n-1}. {w space M. (snth w i = snth x i)})" using stake_inter_snth assms by simp
  moreover have "( i  {0.. n-1}. {w space M. (snth w i = snth x i)})  sets M"
  proof -
    have " i  n-1. {w space M. (snth w i = snth x i)}  sets M"
    proof (intro allI impI)
      fix i
      assume "i  n-1"
      thus "{w  space M. w !! i = x !! i}  sets M"
      proof -
        have "(λw. snth w i)  measurable M (measure_pmf (bernoulli_pmf p))" using assms by (simp add: assms bernoulli_stream_def)
        thus ?thesis by simp
      qed
    qed
    thus ?thesis by auto
  qed
  ultimately show ?thesis by simp
qed

lemma snth_as_fct:
  fixes b
  assumes "M = bernoulli_stream p"
  shows "to_stream -` {w space M. snth w i = b} = {X::natbool. X i = b}"
proof -
  let ?S = "{w space M. snth w i = b}"
  let ?PM = "(λi::nat. (measure_pmf (bernoulli_pmf p)))"
  have isps: "product_prob_space ?PM" by unfold_locales
  let ?Z = "{X::natbool. X i = b}"
  show "to_stream -`?S = ?Z" by (simp add: assms bernoulli_stream_space to_stream_def)
qed

lemma  stake_as_fct:
  assumes "Suc 0  n" and "M= bernoulli_stream p"
  shows "to_stream -`{w space M. (stake n w = stake n x)} = {X::natbool. i. 0  i  i  n-1  X i = snth x i}"
proof -
  let ?S = "{w space M. (stake n w = stake n x)}"
  let ?Z = "{X::natbool. i. 0  i  i  n-1  X i = snth x i}"
  have "to_stream -` ?S = to_stream -` ( i  {0.. n-1}. {w space M. (snth w i = snth x i)})"
    using ‹Suc 0  n stake_inter_snth by blast
  also have "... = ( i  {0.. n-1}. to_stream -`{w space M. (snth w i = snth x i)})" by auto
  also have "... = ( i  {0.. n-1}. {X::natbool. X i = snth x i})" using snth_as_fct assms by simp
  also have "... = ?Z" by auto
  finally show ?thesis .
qed

lemma  bernoulli_stream_npref_prob:
  fixes x
  assumes "M = bernoulli_stream p"
  shows "emeasure M {w space M. (stake 0 w = stake 0 x)} = 1"
proof -
  define S where "S = {w space M. (stake 0 w = stake 0 x)}"
  have "S = space M" unfolding S_def by simp
  thus ?thesis
    by (simp add: assms bernoulli_stream_def prob_space.emeasure_space_1
        prob_space.prob_space_stream_space prob_space_measure_pmf)
qed



lemma bernoulli_stream_pref_prob:
  fixes x
  assumes "M =bernoulli_stream p"
and "0  p" and "p  1"
  shows "n Suc 0 emeasure M {w space M. (stake n w = stake n x)} = (i{0..n-1}. prob_component p x i)"
proof -
  have "prob_space M"
    by (simp add: assms bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
  fix n::nat
  assume "n Suc 0"
  define S where "S = {w space M. (stake n w = stake n x)}"
  have s: "S  sets M" unfolding S_def by (simp add: assms stake_preimage_measurable ‹Suc 0  n)
  define PM where  "PM = (λi::nat. (measure_pmf (bernoulli_pmf p)))"
  have isps: "product_prob_space PM" unfolding PM_def by unfold_locales
  define Z where "Z = {X::natbool. i. 0  i  i  n-1  X i = snth x i}"
  let ?wPM = "PiM UNIV PM"
  define imgSbs where "imgSbs = prod_emb UNIV PM {0..n-1} (PiE {0..n-1} (λi::nat. {snth x i}))"
  have "space ?wPM = UNIV" using space_PiM unfolding PM_def by fastforce
  hence "(to_stream -` S  (space ?wPM)) = to_stream -` S" by simp
  also have "... =  Z" using stake_as_fct ‹Suc 0  n assms unfolding Z_def S_def by simp
  also have "... = imgSbs"
  proof
    {
      fix X
      assume "X  imgSbs"
      hence "restrict X {0..n-1}  (PiE {0..n-1} (λi::nat. {snth x i}))" using prod_emb_iff[of X] unfolding imgSbs_def by simp
      hence "i. 0  i  i  n-1  X i = snth x i" by auto
      hence "X  Z" unfolding Z_def by simp
    }
    thus "imgSbs  Z" by blast
    {
      fix X
      assume "X  Z"
      hence "i. 0  i  i  n-1  X i = snth x i" unfolding Z_def by simp
      hence "restrict X {0..n-1}  (PiE {0..n-1} (λi::nat. {snth x i}))" by simp
      moreover have "X  extensional UNIV" by simp
      moreover have "i  UNIV. X i  space (PM i)" unfolding PM_def by auto
      ultimately have "X  imgSbs"
        using prod_emb_iff[of X] unfolding imgSbs_def by simp
    }
    thus "Z  imgSbs" by auto
  qed
  finally have inteq: "(to_stream -` S  (space ?wPM)) = imgSbs" .

  have "emeasure M S = emeasure ?wPM (to_stream -` S  (space ?wPM))"
    using  emeasure_distr[of "to_stream" ?wPM "M" S] measurable_to_stream[of "(measure_pmf (bernoulli_pmf p))"] s assms
    unfolding bernoulli_stream_def stream_space_def PM_def
    by (simp add: emeasure_distr)
  also have "... = emeasure ?wPM imgSbs" using inteq by simp
  also have "... = (i{0..n-1}. emeasure (PM i) ((λm::nat. {snth x m}) i))"
    using isps  unfolding imgSbs_def PM_def by (auto simp add:product_prob_space.emeasure_PiM_emb)
  also have "... = (i{0..n-1}. prob_component p x i)" using prob_component_measure  unfolding PM_def
  proof -
    have f1: "N f. (n. (n::nat)  N  ¬ 0  f n)  (nN. ennreal (f n)) = ennreal (prod f N)"
      by (metis (no_types) prod_ennreal)
    obtain nn :: "(nat  real)  nat set  nat" where
          f2: "x0 x1. (v2. v2  x1  ¬ 0  x0 v2) = (nn x0 x1  x1  ¬ 0  x0 (nn x0 x1))"
      by moura
    have f3: "s n. if s !! n then prob_component p s n = p else p + prob_component p s n = 1"
      by (simp add: prob_component_def)
    { assume "prob_component p x (nn (prob_component p x) {0..n - 1})  p"
      then have "p + prob_component p x (nn (prob_component p x) {0..n - 1}) = 1"
        using f3 by metis
      then have "nn (prob_component p x) {0..n - 1}  {0..n - 1}  0  prob_component p x (nn (prob_component p x) {0..n - 1})"
        using assms by linarith }
    then have "nn (prob_component p x) {0..n - 1}  {0..n - 1}  0  prob_component p x (nn (prob_component  p x) {0..n - 1})"
      using assms by linarith
    then have "(n = 0..n - 1. ennreal (prob_component p x n)) = ennreal (prod (prob_component p x) {0..n - 1})"
      using f2 f1 by meson
    moreover have "(n = 0..n - 1. ennreal (prob_component p x n)) =
      (n = 0..n - 1. emeasure (measure_pmf (bernoulli_pmf p)) {x !! n})"  using prob_component_measure[of p x]
       assms by simp
    ultimately show "(n = 0..n - 1. emeasure (measure_pmf (bernoulli_pmf p)) {x !! n}) = ennreal (prod (prob_component p x) {0..n - 1})"
      using prob_component_measure[of p x]   by simp
  qed
  finally show "emeasure M S = (i{0..n-1}. prob_component p x i)" .
qed


lemma  bernoulli_stream_pref_prob':
  fixes x
  assumes "M = bernoulli_stream p"
and "p  1" and "0  p"
  shows "emeasure M {w space M. (stake n w = stake n x)} = (i{0..<n}. prob_component p x i)"
proof (cases "Suc 0  n")
  case True
  hence "emeasure M {w space M. (stake n w = stake n x)} = (i{0..n -1}. prob_component p x i)" using assms
    by (simp add: bernoulli_stream_pref_prob)
  moreover have "(i{0..n -1}. prob_component p x i) = (i{0..<n}. prob_component p x i)"
  proof (rule prod.cong)
    show "{0..n - 1} = {0..<n}" using True by auto
    show "xa. xa  {0..<n}  prob_component p x xa = prob_component p x xa" by simp
  qed
  ultimately show ?thesis by simp
next
  case False
  hence "n = 0" using False by simp
  have "{w space M. (stake n w = stake n x)} = space M"
  proof
    show "{w  space M. stake n w = stake n x}  space M"
    proof
      fix w
      assume "w {w  space M. stake n w = stake n x}"
      thus "w  space M" by auto
    qed
    show "space M  {w  space M. stake n w = stake n x}"
    proof
      fix w
      assume "w space M"
      have "stake 0 w = stake 0 x" by simp
      hence "stake n w = stake n x" using n = 0 by simp
      thus "w {w  space M. stake n w = stake n x}" using w space M by auto
    qed
  qed
  hence "emeasure M {w  space M. stake n w = stake n x} = emeasure M (space M)" by simp
  also have "... = 1" using assms
    by (simp add: bernoulli_stream_def prob_space.emeasure_space_1
        prob_space.prob_space_stream_space prob_space_measure_pmf)
  also have "... = (i{0..<n}. prob_component p x i)" using n = 0 by simp
  finally show ?thesis .
qed

lemma  bernoulli_stream_stake_prob:
  fixes x
  assumes "M = bernoulli_stream p"
and "p  1" and "0  p"
shows "measure M {w space M. (stake n w = stake n x)} = (i{0..<n}. prob_component p x i)"
proof -
  have "measure M {w space M. (stake n w = stake n x)} = emeasure M {w space M. (stake n w = stake n x)}"
    by (metis (no_types, lifting) assms(1) bernoulli_stream_def emeasure_eq_ennreal_measure emeasure_space
        ennreal_one_neq_top neq_top_trans prob_space.emeasure_space_1 prob_space.prob_space_stream_space
        prob_space_measure_pmf)
  also have "... = (i{0..<n}. prob_component p x i)" using bernoulli_stream_pref_prob' assms by simp
  finally show ?thesis by (simp add: assms(2) assms(3) prob_component_def prod_nonneg)
qed

lemma (in infinite_coin_toss_space) bernoulli_stream_pseudo_prob:
  fixes x
  assumes "M = bernoulli_stream p"
and "p  1" and "0  p"
and "w range (pseudo_proj_True n)"
shows "measure M (pseudo_proj_True n -`{w}  space M) = (i{0..<n}. prob_component p w i)"
proof -
  have "(pseudo_proj_True n -`{w})  space M = {x space M. (stake n w = stake n x)}"
    using assms(4) infinite_coin_toss_space.pseudo_proj_True_def infinite_coin_toss_space_axioms
      pseudo_proj_True_preimage_stake pseudo_proj_True_stake by force
  thus ?thesis using bernoulli_stream_stake_prob assms
  proof -
    have "pseudo_proj_True n w = w"
      using w  range (pseudo_proj_True n) pseudo_proj_True_proj by blast
    then show ?thesis
      using bernoulli bernoulli_stream_stake_prob p_gt_0 p_lt_1 pseudo_proj_True_preimage_stake_space by presburger
  qed
qed


lemma bernoulli_stream_element_prob_rec:
  fixes x
  assumes "M = bernoulli_stream p"
and "0  p" and "p  1"
  shows " n. emeasure M {w space M. (stake (Suc n) w = stake (Suc n) x)} =
    (emeasure M {w space M. (stake n w = stake n x)} * prob_component p x n)"
proof -
  fix n
  define S where "S = {w space M. (stake (Suc n) w = stake (Suc n) x)}"
  define precS where "precS = {w space M. (stake n w = stake n x)}"
  show "emeasure M S = emeasure M precS * prob_component p x n"
  proof (cases " n 0")
    case True
    hence "n=0" by simp
    hence "emeasure M S = (i{0..n}. prob_component p x i)" unfolding S_def
      using bernoulli_stream_pref_prob assms diff_Suc_1 le_refl by presburger
    also have "... = prob_component p x 0" using True by simp
    also have "... = emeasure M precS * prob_component p x n" using bernoulli_stream_npref_prob assms
      by (simp add: n=0 precS_def)
    finally show "emeasure M S = emeasure M precS * prob_component p x n" .
  next
    case False
    hence "n  Suc 0" by simp
    hence "emeasure M S = (i{0..n}. prob_component p x i)" unfolding S_def
      using bernoulli_stream_pref_prob diff_Suc_1 le_refl assms by fastforce
    also have "... = (i{0..n-1}. prob_component p x i) * prob_component p x n" using n  Suc 0
      by (metis One_nat_def Suc_le_lessD Suc_pred prod.atLeast0_atMost_Suc)
    also have "... = emeasure M precS * prob_component p x n" using bernoulli_stream_pref_prob
      unfolding precS_def
      using ‹Suc 0  n ennreal_mult'' assms prob_component_def by auto
    finally show "emeasure M S = emeasure M precS * prob_component p x n" .
  qed
qed

lemma  bernoulli_stream_element_prob_rec':
  fixes x
  assumes "M = bernoulli_stream p"
and "0  p" and "p  1"
  shows " n. measure M {w space M. (stake (Suc n) w = stake (Suc n) x)} =
    (measure M {w space M. (stake n w = stake n x)} * prob_component p x n)"
proof -
  fix n
  have "ennreal (measure M {w space M. (stake (Suc n) w = stake (Suc n) x)}) =
    emeasure M {w space M. (stake (Suc n) w = stake (Suc n) x)}"
    by (metis (no_types, lifting) assms(1) bernoulli_stream_def emeasure_eq_ennreal_measure
        emeasure_space ennreal_top_neq_one neq_top_trans prob_space.emeasure_space_1
        prob_space.prob_space_stream_space prob_space_measure_pmf)
  also have "... = (emeasure M {w space M. (stake n w = stake n x)} * prob_component p x n)"
    using bernoulli_stream_element_prob_rec assms by simp
  also have "... = (measure M {w space M. (stake n w = stake n x)} * prob_component p x n)"
  proof -
    have "prob_space M"
      using assms(1) bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf by auto
    then show ?thesis
      by (simp add: ennreal_mult'' finite_measure.emeasure_eq_measure mult.commute prob_space_def)
  qed
  finally have "ennreal (measure M {w space M. (stake (Suc n) w = stake (Suc n) x)}) =
    (measure M {w space M. (stake n w = stake n x)} * prob_component p x n)" .
  thus "measure M {w space M. (stake (Suc n) w = stake (Suc n) x)} =
    (measure M {w space M. (stake n w = stake n x)} * prob_component p x n)"
    using assms prob_component_def by auto
qed

lemma (in infinite_coin_toss_space) bernoulli_stream_pseudo_prob_rec':
  fixes x
  assumes "pseudo_proj_True n x = x"
  shows "measure M (pseudo_proj_True (Suc n) -`{x}) =
    (measure M (pseudo_proj_True n-`{x}) * prob_component p x n)"
proof -
  have "pseudo_proj_True (Suc n) -`{x} = {w. (stake (Suc n) w = stake (Suc n) x)}" using pseudo_proj_True_preimage_stake
    assms by (metis pseudo_proj_True_Suc_proj)
  moreover have "pseudo_proj_True n -`{x} = {w. (stake n w = stake n x)}" using pseudo_proj_True_preimage_stake
    assms by simp
  ultimately show ?thesis using assms bernoulli_stream_element_prob_rec'
    by (simp add: bernoulli bernoulli_stream_space p_gt_0 p_lt_1)
qed


lemma (in infinite_coin_toss_space) bernoulli_stream_pref_prob_pos:
  fixes x
  assumes "0 < p"
and "p < 1"
  shows "emeasure M {w space M. (stake n w = stake n x)} > 0"
proof (induct n)
  case 0
  hence "emeasure M {w space M. (stake 0 w = stake 0 x)} = 1" using bernoulli_stream_npref_prob[of M p x]
    bernoulli by simp
  thus ?case by simp
next
  case (Suc n)
  have "emeasure M {w  space M. stake (Suc n) w = stake (Suc n) x} =
    (emeasure M {w space M. (stake n w = stake n x)} * prob_component p x n)" using bernoulli_stream_element_prob_rec
    bernoulli p_gt_0 p_lt_1 by simp
  thus ?case using Suc using assms p_gt_0 p_lt_1 prob_component_def
    by (simp add: ennreal_zero_less_mult_iff)
qed

lemma (in infinite_coin_toss_space) bernoulli_stream_pref_prob_neq_zero:
  fixes x
assumes "0 < p"
and "p < 1"
  shows "emeasure M {w space M. (stake n w = stake n x)}  0"
proof (induct n)
  case 0
  hence "emeasure M {w space M. (stake 0 w = stake 0 x)} = 1" using bernoulli_stream_npref_prob[of M p x]
    bernoulli by simp
  thus ?case by simp
next
  case (Suc n)
  have "emeasure M {w  space M. stake (Suc n) w = stake (Suc n) x} =
    (emeasure M {w space M. (stake n w = stake n x)} * prob_component p x n)" using bernoulli_stream_element_prob_rec
    bernoulli assms by simp
  thus ?case using Suc using assms p_gt_0 p_lt_1 prob_component_def by auto
qed



lemma (in infinite_coin_toss_space) pseudo_proj_element_prob_pref:
  assumes "w range (pseudo_proj_True n)"
  shows "emeasure M {y space M. x  (pseudo_proj_True n -`{w}). y = c ## x} =
    prob_component p (c##w) 0 * emeasure M ((pseudo_proj_True n) -`{w}  space M)"
proof -
  have "pseudo_proj_True n w = w" using assms pseudo_proj_True_def pseudo_proj_True_stake by auto
  have "pseudo_proj_True (Suc n) (c##w) = c##w" using assms
          pseudo_proj_True_def pseudo_proj_True_stake by auto
  have "{y space M. x  (pseudo_proj_True n -`{w}). y = c ## x} = pseudo_proj_True (Suc n) -`{c##w}  space M"
  proof
    show "{y space M. xpseudo_proj_True n -` {w}. y = c ## x}  pseudo_proj_True (Suc n) -` {c ## w}  space M"
    proof
      fix y
      assume "y {y space M. xpseudo_proj_True n -` {w}. y = c ## x}"
      hence "y space M" and "x  pseudo_proj_True n -` {w}. y = c ## x" by auto
      from this obtain x where "x pseudo_proj_True n -` {w}" and "y = c## x" by auto
      have "pseudo_proj_True (Suc n) y = c##w" using x pseudo_proj_True n -` {w} y = c## x
        unfolding pseudo_proj_True_def by simp
      thus "y  pseudo_proj_True (Suc n) -` {c ## w}  space M" using y space M by auto
    qed
    show "pseudo_proj_True (Suc n) -` {c ## w}  space M  {y space M. xpseudo_proj_True n -` {w}. y = c ## x}"
    proof
      fix y
      assume "y  pseudo_proj_True (Suc n) -` {c ## w}  space M"
      hence "pseudo_proj_True (Suc n) y = c##w" and "y space M" by auto
      have "pseudo_proj_True n (stl y) = pseudo_proj_True n w"
      proof (rule pseudo_proj_True_snth')
        have "pseudo_proj_True (Suc n) (c##w) = c##w" using ‹pseudo_proj_True (Suc n) (c##w) = c##w .
        also have "... = pseudo_proj_True (Suc n) y" using ‹pseudo_proj_True (Suc n) y = c##w by simp
        finally have "pseudo_proj_True (Suc n) (c##w) = pseudo_proj_True (Suc n) y" .
        hence "i. Suc i  Suc n  (c##w)!! i = y!! i" by (simp add: pseudo_proj_True_snth)
        thus "i. Suc i  n  stl y !! i = w !! i" by fastforce
      qed
      also have "... = w" using assms pseudo_proj_True_def pseudo_proj_True_stake by auto
      finally have "pseudo_proj_True n (stl y) = w" .
      hence "stl y  (pseudo_proj_True n) -` {w}" by simp
      moreover have "y = c##(stl y)"
      proof -
        have "stake (Suc n) y = stake (Suc n) (pseudo_proj_True (Suc n) y)" unfolding pseudo_proj_True_def
          using pseudo_proj_True_def pseudo_proj_True_stake by auto
        hence "shd y = shd (pseudo_proj_True (Suc n) y)" by simp
        also have "... = shd (c##w)" using ‹pseudo_proj_True (Suc n) y = c##w by simp
        also have "... = c" by simp
        finally have "shd y = c" .
        thus ?thesis by (simp add: stream_eq_Stream_iff)
      qed
      ultimately show "y {y space M. xpseudo_proj_True n -` {w}. y = c ## x}" using y space M by auto
    qed
  qed
  hence "emeasure M {y space M. x  (pseudo_proj_True n -`{w}). y = c ## x} =
    emeasure M (pseudo_proj_True (Suc n) -`{c##w} space M)" by simp
  also have "... = emeasure M {y space M. stake (Suc n) y = stake (Suc n) (c##w)}"
    using ‹pseudo_proj_True (Suc n) (c##w) = c##w by (simp add:pseudo_proj_True_preimage_stake_space)
  also have "... = (i{0..n}. prob_component p (c##w) i)"
    using bernoulli_stream_pref_prob[of M p "Suc n" "c##w"] bernoulli p_lt_1 p_gt_0 diff_Suc_1 le_refl by simp
  also have "... = prob_component p (c##w) 0 * (i{1..n}. prob_component p (c##w) i)"
    by (simp add: decompose_init_prod)
  also have "... = prob_component p (c##w) 0 * (i{1..< Suc n}. prob_component p (c##w) i)"
  proof -
    have "(i{1..n}. prob_component p (c##w) i) = (i{1..< Suc n}. prob_component p (c##w) i)"
    proof (rule prod.cong)
      show "{1..n} = {1..<Suc n}" by auto
      show "x. x  {1..<Suc n}  prob_component p (c ## w) x = prob_component p (c ## w) x" by simp
    qed
    thus ?thesis by simp
  qed
  also have "... = prob_component p (c##w) 0 * (i{0..< n}. prob_component p w i)"
  proof -
    have "(i{1..< Suc n}. prob_component p (c##w) i) = (i{0..< n}. prob_component p w i)"
    proof (rule prod.reindex_cong)
      show "inj_on (λn. Suc n) {0..<n}" by simp
      show "{1..< Suc n} = Suc ` {0..< n}"  by auto
      show "x. x  {0..< n}  prob_component p (c ## w) (Suc x) = prob_component p w x"
        by (simp add: prob_component_def)
    qed
    thus ?thesis by simp
  qed
  also have "... = prob_component p (c##w) 0 * emeasure M {y  space M. stake n y = stake n w}"
    using bernoulli_stream_pref_prob'[symmetric, of M p w n] ennreal_mult' p_gt_0 p_lt_1 bernoulli
    prob_component_def by auto
  also have "... = prob_component p (c##w) 0 * emeasure M (pseudo_proj_True n -` {w}  space M)"
    using pseudo_proj_True_preimage_stake_space ‹pseudo_proj_True n w = w
    by (simp add: pseudo_proj_True_preimage_stake_space)
  finally show ?thesis .
qed

subsubsection ‹Filtration equivalence for the natural filtration›

lemma (in infinite_coin_toss_space) nat_filtration_null_set:
  assumes "A sets (nat_filtration n)"
and "0 < p"
and "p  < 1"
and "emeasure M A = 0"
shows "A = {}"
proof (rule ccontr)
  assume "A {}"
  hence "w. w A" by auto
  from this obtain w where "w  A" by auto
  hence inc: "pseudo_proj_True n -` {pseudo_proj_True n w}  A" using assms by (simp add: set_filt_contain)
  have "0 < emeasure M {x space M. (stake n x = stake n (pseudo_proj_True n w))}" using assms by (simp add: bernoulli_stream_pref_prob_pos)
  also have "... = emeasure M (pseudo_proj_True n -` {pseudo_proj_True n w})" using pseudo_proj_True_preimage_stake
    pseudo_proj_True_proj bernoulli bernoulli_stream_space by simp
  also have "...  emeasure M A"
  proof (rule emeasure_mono, (simp add: inc))
    show "A  events" using assms nat_discrete_filtration unfolding filtration_def subalgebra_def by auto
  qed
  finally have "0 < emeasure M A" .
  thus False using assms by simp
qed

lemma (in infinite_coin_toss_space) nat_filtration_AE_zero:
  fixes f::"bool stream  real"
  assumes "AE w in M. f w = 0"
and "f borel_measurable (nat_filtration n)"
and "0 < p"
and "p < 1"
  shows "w. f w = 0"
proof -
  from AE w in M. f w = 0 obtain N' where Nprops: "{w space M. ¬f w = 0}  N'" "N' sets M" "emeasure M N' = 0"
    by (force elim:AE_E)
  have "{w space M. f w < 0}  sets (nat_filtration n)"
    by (metis (no_types) assms(2) bernoulli bernoulli_stream_space borel_measurable_iff_less nat_filtration_space streams_UNIV)
  moreover have "{w space M. f w > 0}  sets (nat_filtration n)"
    by (metis (no_types) assms(2) bernoulli bernoulli_stream_space borel_measurable_iff_greater nat_filtration_space streams_UNIV)
  moreover have "{w space M. ¬f w = 0} = {w space M. f w < 0}  {w space M. f w > 0}" by auto
  ultimately have "{w space M. ¬f w = 0}  sets (nat_filtration n)" by auto
  hence "emeasure M {w space M. ¬f w = 0} = 0" using Nprops by (metis (no_types, lifting) emeasure_eq_0)
  hence "{w space M. ¬f w = 0} = {}" using {w space M. ¬f w = 0}  sets (nat_filtration n)
      nat_filtration_null_set[of "{w  space M. f w  0}" n] assms by simp
  hence "{w. f w 0} = {}" by (simp add:bernoulli_stream_space bernoulli)
  thus ?thesis by auto
qed


lemma (in infinite_coin_toss_space) nat_filtration_AE_eq:
  fixes f::"bool stream  real"
  assumes "AE w in M. f w = g w"
and "0 < p"
and "p < 1"
and "f borel_measurable (nat_filtration n)"
and "g borel_measurable (nat_filtration n)"
  shows "f w = g w"
proof -
  define diff where "diff = (λw. f w - g w)"
  have "AE w in M. diff w = 0"
  proof (rule AE_mp)
    show "AE w in M. f w = g w" using assms by simp
    show "AE w in M. f w = g w  diff w = 0"
      by (rule AE_I2, intro impI, (simp add: diff_def))
  qed
  have "w. diff w = 0"
  proof (rule nat_filtration_AE_zero)
    show "AE w in M. diff w = 0" using AE w in M. diff w = 0 .
    show "diff  borel_measurable (nat_filtration n)" using assms unfolding diff_def by simp
    show "0 < p" and "p < 1" using assms by auto
  qed
  thus "f w = g w" unfolding diff_def by auto
qed



lemma (in infinite_coin_toss_space) bernoulli_stream_equiv:
  assumes "N = bernoulli_stream q"
and "0 < p"
and "p < 1"
and "0 < q"
and "q < 1"
shows "filt_equiv nat_filtration M N" unfolding filt_equiv_def
proof (intro conjI)
  have "sets (stream_space (measure_pmf (bernoulli_pmf p))) = sets (stream_space (measure_pmf (bernoulli_pmf q)))"
    by (rule sets_stream_space_cong, simp)
  thus "events = sets N" using assms bernoulli unfolding bernoulli_stream_def by simp
  show "filtration M nat_filtration" by (simp add:nat_discrete_filtration)
  show "t A. A  sets (nat_filtration t)  (emeasure M A = 0) = (emeasure N A = 0)"
  proof (intro allI impI)
    fix n
    fix A
    assume "A sets (nat_filtration n)"
    show "(emeasure M A = 0) = (emeasure N A = 0)"
    proof
    {
      assume "emeasure M A = 0"
      hence "A = {}" using A sets (nat_filtration n) using assms by (simp add:nat_filtration_null_set)
      thus "emeasure N A = 0" by simp
    }
    {
      assume "emeasure N A = 0"
      hence "A = {}" using A sets (nat_filtration n) infinite_coin_toss_space.nat_filtration_null_set[of q N A n]
        assms
        using ‹events = sets N bernoulli bernoulli_stream_space infinite_coin_toss_space.nat_filtration_sets
          infinite_coin_toss_space_def nat_filtration_sets by force
      thus "emeasure M A = 0" by simp
    }
    qed
  qed
qed

lemma (in infinite_coin_toss_space) bernoulli_nat_filtration:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "0 < p"
and "p < 1"
shows "infinite_cts_filtration q N nat_filtration"
proof (unfold_locales)
  have "0 < q" using assms by simp
  thus "0  q" by simp
  have "q < 1" using assms by simp
  thus "q  1" by simp
  show "N = bernoulli_stream q" using assms by simp
  show "nat_filtration = infinite_coin_toss_space.nat_filtration N"
  proof -
    have "filt_equiv nat_filtration M N" using q < 1 0 < q
      by (simp add: assms bernoulli_stream_equiv)
    hence "sets M = sets N" unfolding filt_equiv_def by simp
    hence "space M = space N" using sets_eq_imp_space_eq by auto
    have "m. nat_filtration m = infinite_coin_toss_space.nat_filtration N m"
    proof
      fix m
      have "infinite_coin_toss_space.nat_filtration N m = fct_gen_subalgebra N N (pseudo_proj_True m)"
        using 0  q N = bernoulli_stream q q  1 infinite_coin_toss_space.intro
        infinite_coin_toss_space.nat_filtration_def by blast
      thus "nat_filtration m = infinite_coin_toss_space.nat_filtration N m"
        unfolding nat_filtration_def
        using fct_gen_subalgebra_cong[of M N M N "pseudo_proj_True m"] ‹sets M = sets N ‹space M = space N
        by simp
    qed
    thus ?thesis by auto
  qed
qed


subsubsection ‹More results on the projection function›

lemma (in infinite_coin_toss_space) pseudo_proj_True_Suc_prefix:
  shows "pseudo_proj_True (Suc n) w = (w!!0)## pseudo_proj_True n (stl w)"
proof -
  have "pseudo_proj_True (Suc n) w = shift (stake (Suc n) w) (sconst True)" unfolding pseudo_proj_True_def by simp
  also have "... = shift (w!!0 # (stake n (stl w))) (sconst True)" by simp
  also have "... = w!!0 ## shift (stake n (stl w)) (sconst True)" by simp
  also have "... = w!!0 ## pseudo_proj_True n (stl w)" unfolding pseudo_proj_True_def by simp
  finally show ?thesis .
qed

lemma (in infinite_coin_toss_space) pseudo_proj_True_img:
  assumes "pseudo_proj_True n w = w"
  shows "w range (pseudo_proj_True n)"
  by (metis assms rangeI)

lemma (in infinite_coin_toss_space) sconst_if:
  assumes "n. snth w n = True"
  shows "w = sconst True"
proof -
  obtain nn :: "(bool  bool)  bool stream  bool stream  nat" where
    "p s n sa sb na pa sc pb sd se. (¬ p (s !! n::bool)  smap p s  sa  sa !! n)  (¬ sb !! na  smap pa sc  sb  pa (sc !! na::bool))  (¬ pb (sd !! nn pb sd se)  ¬ se !! nn pb sd se  smap pb sd = se)"
    using smap_alt by moura
  then show ?thesis
    by (metis (no_types) assms eq_id_iff id_funpow snth_siterate)
qed

lemma (in infinite_coin_toss_space) pseudo_proj_True_suc_img_pref:
  shows "range (pseudo_proj_True (Suc n)) = {y. w  range (pseudo_proj_True n). y = True ## w} 
    {y. w  range (pseudo_proj_True n). y = False ## w}"
proof
  show "range (pseudo_proj_True (Suc n))
     {y. w  range (pseudo_proj_True n). y = True ## w}  {y. w  range (pseudo_proj_True n). y = False ## w}"
  proof
    fix x
    assume "x  range (pseudo_proj_True (Suc n))"
    hence "x = pseudo_proj_True (Suc n) x" using pseudo_proj_True_proj by auto
    define xp where "xp = stl x"
    have "xp = stl (shift (stake (Suc n) x) (sconst True))" using x = pseudo_proj_True (Suc n) x
      unfolding xp_def pseudo_proj_True_def by simp
    also have "... = shift ((stake n (stl x))) (sconst True)" by simp
    finally have "xp = shift ((stake n (stl x))) (sconst True)" .
    hence "xp  range (pseudo_proj_True n)" using  pseudo_proj_True_def by auto
    show "x {y. w  range (pseudo_proj_True n) . y = True ## w}  {y. w  range (pseudo_proj_True n). y = False ## w}"
    proof (cases "snth x 0")
      case True
      have "x = True ## xp" unfolding xp_def using True by (simp add: stream_eq_Stream_iff)
      hence "x  {y. w  range (pseudo_proj_True n). y = True ## w}" using xp  range (pseudo_proj_True n) by auto
      thus ?thesis by auto
    next
      case False
      have "x = False ## xp" unfolding xp_def using False by (simp add: stream_eq_Stream_iff)
      hence "x  {y. w  range (pseudo_proj_True n). y = False ## w}" using xp  range (pseudo_proj_True n) by auto
      thus ?thesis by auto
    qed
  qed
  have "{y. w  range (pseudo_proj_True n) . y = True ## w}  range (pseudo_proj_True (Suc n))"
  proof
    fix y
    assume "y  {y. w  range (pseudo_proj_True n) . y = True ## w}"
    hence "w. w  range (pseudo_proj_True n)  y = True ## w" by auto
    from this obtain w where "w range (pseudo_proj_True n)" and "y = True ## w" by auto
    have "w = pseudo_proj_True n w" using pseudo_proj_True_proj w range (pseudo_proj_True n) by auto
    hence "y = True ## (shift (stake n w) (sconst True))" using y = True ## w unfolding pseudo_proj_True_def by simp
    also have "... = shift (stake (Suc n) (True ## w)) (sconst True)" by simp
    also have "... = pseudo_proj_True (Suc n) (True ## w)" unfolding pseudo_proj_True_def by simp
    finally have "y = pseudo_proj_True (Suc n) (True##w)" .
    thus "y  range (pseudo_proj_True (Suc n))" by simp
  qed
  moreover have "{y. w  range (pseudo_proj_True n) . y = False ## w}  range (pseudo_proj_True (Suc n))"
  proof
    fix y
    assume "y  {y. w  range (pseudo_proj_True n) . y = False ## w}"
    hence "w. w  range (pseudo_proj_True n)  y = False ## w" by auto
    from this obtain w where "w range (pseudo_proj_True n)" and "y = False ## w" by auto
    have "w = pseudo_proj_True n w" using pseudo_proj_True_proj w range (pseudo_proj_True n) by auto
    hence "y = False ## (shift (stake n w) (sconst True))" using y = False ## w unfolding pseudo_proj_True_def by simp
    also have "... = shift (stake (Suc n) (False ## w)) (sconst True)" by simp
    also have "... = pseudo_proj_True (Suc n) (False ## w)" unfolding pseudo_proj_True_def by simp
    finally have "y = pseudo_proj_True (Suc n) (False##w)" .
    thus "y  range (pseudo_proj_True (Suc n))" by simp
  qed
  ultimately show "{y. w  range (pseudo_proj_True n) . y = True ## w} 
   {y. w  range (pseudo_proj_True n) . y = False ## w}  range (pseudo_proj_True (Suc n))" by simp
qed

lemma (in infinite_coin_toss_space) reindex_pseudo_proj:
  shows "(wrange (pseudo_proj_True n). f (c ## w)) =
      (y{y. w  range (pseudo_proj_True n). y = c ## w}.f y)"
proof (rule sum.reindex_cong[symmetric],auto)
  define ccons where "ccons = (λw. c## w)"
  show "inj_on ccons (range (pseudo_proj_True n))"
  proof
    fix x y
    assume "x range (pseudo_proj_True n)" and "y range (pseudo_proj_True n)" and "ccons x = ccons y"
    hence "c##x = c##y" unfolding ccons_def by simp
    thus "x = y" by simp
  qed
qed


lemma (in infinite_coin_toss_space) pseudo_proj_True_imp_False:
  assumes "pseudo_proj_True n w = pseudo_proj_True n x"
  shows "pseudo_proj_False n w = pseudo_proj_False n x"
  by (metis assms pseudo_proj_False_def pseudo_proj_True_stake)


lemma (in infinite_coin_toss_space) pseudo_proj_Suc_prefix:
  assumes "pseudo_proj_True n w = pseudo_proj_True n x"
  shows "pseudo_proj_True (Suc n) w  {pseudo_proj_True n x, pseudo_proj_False n x}"
proof -
  have "pseudo_proj_False n w = pseudo_proj_False n x" using assms pseudo_proj_True_imp_False[of n w x] by simp
  hence "{pseudo_proj_True n w, pseudo_proj_False n w} = {pseudo_proj_True n x, pseudo_proj_False n x}" using assms by simp
  thus ?thesis using pseudo_proj_True_suc_img[of n w] by simp
qed


lemma (in infinite_coin_toss_space) pseudo_proj_Suc_preimage:
  shows "range (pseudo_proj_True (Suc n))  (pseudo_proj_True n) -` {pseudo_proj_True n x} =
    {pseudo_proj_True n x, pseudo_proj_False n x}"
proof
  show "range (pseudo_proj_True (Suc n))  pseudo_proj_True n -` {pseudo_proj_True n x}
     {pseudo_proj_True n x, pseudo_proj_False n x}"
  proof
    fix w
    assume "w range (pseudo_proj_True (Suc n))  pseudo_proj_True n -` {pseudo_proj_True n x}"
    hence "w range (pseudo_proj_True (Suc n))" and "w pseudo_proj_True n -` {pseudo_proj_True n x}" by auto
    hence "pseudo_proj_True n w = pseudo_proj_True n x" by simp
    have "w = pseudo_proj_True (Suc n) w" using w range (pseudo_proj_True (Suc n))
      using pseudo_proj_True_proj by auto
    also have "...  {pseudo_proj_True n x, pseudo_proj_False n x}" using ‹pseudo_proj_True n w = pseudo_proj_True n x
      pseudo_proj_Suc_prefix by simp
    finally show "w  {pseudo_proj_True n x, pseudo_proj_False n x}" .
  qed
  show "{pseudo_proj_True n x, pseudo_proj_False n x}
     range (pseudo_proj_True (Suc n))  pseudo_proj_True n -` {pseudo_proj_True n x}"
  proof -
    have "pseudo_proj_True n x  range (pseudo_proj_True (Suc n))  pseudo_proj_True n -` {pseudo_proj_True n x}"
      by (simp add: pseudo_proj_True_Suc_proj pseudo_proj_True_img pseudo_proj_True_proj)
    moreover have "pseudo_proj_False n x  range (pseudo_proj_True (Suc n))  pseudo_proj_True n -` {pseudo_proj_True n x}"
      by (metis (no_types, lifting) Int_iff UnI2 infinite_coin_toss_space.pseudo_proj_False_def infinite_coin_toss_space_axioms
          pseudo_proj_True_Suc_False_proj pseudo_proj_True_inverse_induct pseudo_proj_True_stake rangeI singletonI vimage_eq)
    ultimately show ?thesis by auto
  qed
qed


lemma (in infinite_cts_filtration) f_borel_Suc_preimage:
  assumes "f measurable (F n) N"
  and "set_discriminating n f N"
  shows "range (pseudo_proj_True (Suc n))  f -` {f x} =
  (pseudo_proj_True n) ` (f -` {f x})  (pseudo_proj_False n) ` (f -` {f x})"
proof -
  have "range (pseudo_proj_True (Suc n))  f -` {f x} =
    ( w {y. f y = f x}.{pseudo_proj_True n w, pseudo_proj_False n w})"
  proof
    show "range (pseudo_proj_True (Suc n))  f -` {f x}  (w{y. f y = f x}. {pseudo_proj_True n w, pseudo_proj_False n w})"
    proof
      fix w
      assume "w range (pseudo_proj_True (Suc n))  f -` {f x}"
      hence "w range (pseudo_proj_True (Suc n))" and "w f -` {f x}" by auto
      hence "f w = f x" by simp
      hence "w {y. f y = f x}" by simp
      have "w = pseudo_proj_True (Suc n) w" using w range (pseudo_proj_True (Suc n))
        using pseudo_proj_True_proj by auto
      also have "...  {pseudo_proj_True n w, pseudo_proj_False n w}"
        using pseudo_proj_Suc_prefix by auto
      also have "...  (w{y. f y = f x}. {pseudo_proj_True n w, pseudo_proj_False n w})" using w {y. f y = f x}
        by auto
      finally show "w  (w{y. f y = f x}. {pseudo_proj_True n w, pseudo_proj_False n w})" .
    qed
    show "(w{y. f y = f x}. {pseudo_proj_True n w, pseudo_proj_False n w})
       range (pseudo_proj_True (Suc n))  f -` {f x}"
    proof
      fix w
      assume "w  (w{y. f y = f x}. {pseudo_proj_True n w, pseudo_proj_False n w})"
      hence "y. f y = f x  w {pseudo_proj_True n y, pseudo_proj_False n y}" by auto
      from this obtain y where "f y = f x" and "w {pseudo_proj_True n y, pseudo_proj_False n y}" by auto
      hence "w = pseudo_proj_True n y  w = pseudo_proj_False n y" by auto
      show "w  range (pseudo_proj_True (Suc n))  f -` {f x}"
      proof (cases "w = pseudo_proj_True n y")
        case True
        hence "f w = f y" using assms nat_filtration_not_borel_info natural_filtration
          by (metis comp_apply)
        thus ?thesis using f y = f x
          by (simp add: True pseudo_proj_True_Suc_proj pseudo_proj_True_img)
      next
        case False
        hence "f w = f y" using assms nat_filtration_not_borel_info natural_filtration
          by (metis Int_iff w  {pseudo_proj_True n y, pseudo_proj_False n y}
              comp_apply pseudo_proj_Suc_preimage singletonD vimage_eq)
      thus ?thesis using f y = f x
        using w  {pseudo_proj_True n y, pseudo_proj_False n y} pseudo_proj_Suc_preimage by auto
      qed
    qed
  qed
  also have "... =
    ( w {y. f y = f x}.{pseudo_proj_True n w})  ( w {y. f y = f x}.{pseudo_proj_False n w})" by auto
  also have "... = (pseudo_proj_True n) ` {y. f y = f x}  (pseudo_proj_False n) `{y. f y = f x}" by auto
  also have "... = (pseudo_proj_True n) ` (f -` {f x})  (pseudo_proj_False n) ` (f -` {f x})" by auto
  finally show ?thesis .
qed



lemma (in infinite_cts_filtration) pseudo_proj_preimage:
  assumes "g measurable (F n) N"
  and "set_discriminating n g N"
  shows "pseudo_proj_True n -` (g -` {g z}) = pseudo_proj_True n -` (pseudo_proj_True n `(g -` {g z}))"
proof
  show "pseudo_proj_True n -` g -` {g z}  pseudo_proj_True n -` pseudo_proj_True n ` g -` {g z}"
  proof
    fix w
    assume "w pseudo_proj_True n -` g -` {g z}"
    have "pseudo_proj_True n w = pseudo_proj_True n (pseudo_proj_True n w)"
      by (simp add: pseudo_proj_True_proj)
    also have "...  pseudo_proj_True n `(g -` {g z})" using w pseudo_proj_True n -` g -` {g z}
      by simp
    finally have "pseudo_proj_True n w  pseudo_proj_True n `(g -` {g z})" .
    thus "w pseudo_proj_True n -` (pseudo_proj_True n `(g -` {g z}))" by simp
  qed
  show "pseudo_proj_True n -` pseudo_proj_True n ` g -` {g z}  pseudo_proj_True n -` g -` {g z}"
  proof
    fix w
    assume "w  pseudo_proj_True n -` pseudo_proj_True n ` g -` {g z}"
    hence "y. pseudo_proj_True n w = pseudo_proj_True n y  g y = g z" by auto
    from this obtain y where "pseudo_proj_True n w = pseudo_proj_True n y" and "g y = g z" by auto
    have "g (pseudo_proj_True n w) = g (pseudo_proj_True n y)" using ‹pseudo_proj_True n w = pseudo_proj_True n y
      by simp
    also have "... = g y" using assms nat_filtration_not_borel_info natural_filtration by (metis comp_apply)
    also have "... = g z" using g y = g z .
    finally have "g (pseudo_proj_True n w) = g z" .
    thus "w pseudo_proj_True n -` g -` {g z}" by simp
  qed
qed


lemma (in infinite_cts_filtration) borel_pseudo_proj_preimage:
  fixes g::"bool stream  'b::{t0_space}"
  assumes "g borel_measurable (F n)"
  shows "pseudo_proj_True n -` (g -` {g z}) = pseudo_proj_True n -` (pseudo_proj_True n `(g -` {g z}))"
  using pseudo_proj_preimage[of g n borel z] set_discriminating_if[of g n] natural_filtration assms by simp

lemma (in infinite_cts_filtration) pseudo_proj_False_preimage:
  assumes "g measurable (F n) N"
  and "set_discriminating n g N"
  shows "pseudo_proj_False n -` (g -` {g z}) = pseudo_proj_False n -` (pseudo_proj_False n `(g -` {g z}))"
proof
  show "pseudo_proj_False n -` g -` {g z}  pseudo_proj_False n -` pseudo_proj_False n ` g -` {g z}"
  proof
    fix w
    assume "w pseudo_proj_False n -` g -` {g z}"
    have "pseudo_proj_False n w = pseudo_proj_False n (pseudo_proj_False n w)"
      using pseudo_proj_False_def pseudo_proj_False_stake by auto
    also have "...  pseudo_proj_False n `(g -` {g z})" using w pseudo_proj_False n -` g -` {g z}
      by simp
    finally have "pseudo_proj_False n w  pseudo_proj_False n `(g -` {g z})" .
    thus "w pseudo_proj_False n -` (pseudo_proj_False n `(g -` {g z}))" by simp
  qed
  show "pseudo_proj_False n -` pseudo_proj_False n ` g -` {g z}  pseudo_proj_False n -` g -` {g z}"
  proof
    fix w
    assume "w  pseudo_proj_False n -` pseudo_proj_False n ` g -` {g z}"
    hence "y. pseudo_proj_False n w = pseudo_proj_False n y  g y = g z" by auto
    from this obtain y where "pseudo_proj_False n w = pseudo_proj_False n y" and "g y = g z" by auto
    have "g (pseudo_proj_False n w) = g (pseudo_proj_False n y)" using ‹pseudo_proj_False n w = pseudo_proj_False n y
      by simp
    also have "... = g y" using assms nat_filtration_not_borel_info' natural_filtration by (metis comp_apply)
    also have "... = g z" using g y = g z .
    finally have "g (pseudo_proj_False n w) = g z" .
    thus "w pseudo_proj_False n -` g -` {g z}" by simp
  qed
qed

lemma (in infinite_cts_filtration) borel_pseudo_proj_False_preimage:
  fixes g::"bool stream  'b::{t0_space}"
  assumes "g borel_measurable (F n)"
  shows "pseudo_proj_False n -` (g -` {g z}) = pseudo_proj_False n -` (pseudo_proj_False n `(g -` {g z}))"
using pseudo_proj_False_preimage[of g n borel z] set_discriminating_if[of g n] natural_filtration assms by simp


lemma (in infinite_cts_filtration) pseudo_proj_preimage':
  assumes "g measurable (F n) N"
  and "set_discriminating n g N"
  shows "pseudo_proj_True n -` (g -` {g z}) = g -` {g z}"
proof
  show "pseudo_proj_True n -` g -` {g z}  g -` {g z}"
  proof
    fix w
    assume "w pseudo_proj_True n -` g -` {g z}"
    have "g w = g (pseudo_proj_True n w)" using assms nat_filtration_not_borel_info natural_filtration
      by (metis comp_apply)
    also have "... = g z" using w pseudo_proj_True n -` g -` {g z} by simp
    finally have "g w = g z".
    thus "w g -`{g z}" by simp
  qed
  show "g -` {g z}  pseudo_proj_True n -` g -` {g z}"
  proof
    fix w
    assume "w  g -` {g z}"
    have "g (pseudo_proj_True n w) = g w" using assms nat_filtration_not_borel_info natural_filtration
      by (metis comp_apply)
    also have "... = g z" using w g -`{g z} by simp
    finally have "g (pseudo_proj_True n w) = g z" .
    thus "w pseudo_proj_True n -` g -` {g z}" by simp
  qed
qed

lemma (in infinite_cts_filtration) borel_pseudo_proj_preimage':
  fixes g::"bool stream  'b::{t0_space}"
  assumes "g borel_measurable (F n)"
  shows "pseudo_proj_True n -` (g -` {g z}) = g -` {g z}"
  using assms natural_filtration by (simp add: set_discriminating_if pseudo_proj_preimage')


lemma (in infinite_cts_filtration) pseudo_proj_False_preimage':
  assumes "g measurable (F n) N"
  and "set_discriminating n g N"
  shows "pseudo_proj_False n -` (g -` {g z}) = g -` {g z}"
proof
  show "pseudo_proj_False n -` g -` {g z}  g -` {g z}"
  proof
    fix w
    assume "w pseudo_proj_False n -` g -` {g z}"
    have "g w = g (pseudo_proj_False n w)" using assms nat_filtration_not_borel_info' natural_filtration
      by (metis comp_apply)
    also have "... = g z" using w pseudo_proj_False n -` g -` {g z} by simp
    finally have "g w = g z".
    thus "w g -`{g z}" by simp
  qed
  show "g -` {g z}  pseudo_proj_False n -` g -` {g z}"
  proof
    fix w
    assume "w  g -` {g z}"
    have "g (pseudo_proj_False n w) = g w" using assms nat_filtration_not_borel_info' natural_filtration
      by (metis comp_apply)
    also have "... = g z" using w g -`{g z} by simp
    finally have "g (pseudo_proj_False n w) = g z" .
    thus "w pseudo_proj_False n -` g -` {g z}" by simp
  qed
qed


lemma (in infinite_cts_filtration) borel_pseudo_proj_False_preimage':
  fixes g::"bool stream  'b::{t0_space}"
  assumes "g borel_measurable (F n)"
  shows "pseudo_proj_False n -` (g -` {g z}) = g -` {g z}"
using assms natural_filtration by (simp add: set_discriminating_if pseudo_proj_False_preimage')

subsubsection ‹Integrals and conditional expectations on the natural filtration›

lemma (in infinite_cts_filtration) cst_integral:
  fixes f::"bool streamreal"
  assumes "f  borel_measurable (F 0)"
  and "f (sconst True) = c"
shows "has_bochner_integral M f c"
proof -
  have "space M = space (F 0)"  using filtration by (simp add: filtration_def subalgebra_def)
  have "f borel_measurable M"
    using assms(1) nat_filtration_borel_measurable_integrable natural_filtration by blast
  have "d. x space (F 0). f x = d"
  proof (rule triv_measurable_cst)
    show "space (F 0) = space M" using ‹space M = space (F 0) ..
    show "sets (F 0) = {{}, space M}" using info_disc_filtr
      by (simp add: init_triv_filt_def bot_nat_def)
    show "f  borel_measurable (F 0)" using assms by simp
    show "space M  {}" by (simp add:not_empty)
  qed
  from this obtain d where "x space (F 0). f x = d" by auto
  hence " x space M. f x = d" using ‹space M = space (F 0) by simp
  hence "f (sconst True) = d" using bernoulli_stream_space bernoulli  by simp
  hence "c = d" using assms by simp
  hence "x space M. f x = c" using  x space M. f x = d c = d by simp
  have "f borel_measurable M"
    using assms(1) nat_filtration_borel_measurable_integrable natural_filtration by blast
  have "integralN M f = integralN M (λw. c)"
  proof (rule nn_integral_cong)
    fix x
    assume "x space M"
    thus "ennreal (f x) = ennreal c" using  x space M. f x = d c = d by auto
  qed
  also have "... = integralN M (λw. c * (indicator (space M)) w)"
    by (simp add: nn_integral_cong)
  also have "... = ennreal c * emeasure M (space M)" using nn_integral_cmult_indicator[of "space M" M c]
    by (simp add: nn_integral_cong)
  also have "... = ennreal c" by (simp add: emeasure_space_1)
  finally have "integralN M f = ennreal c" .
  hence "integralN M (λx. - f x) = ennreal (-c)"
    by (simp add: xspace M. f x = d c = d emeasure_space_1 nn_integral_cong)
  show "has_bochner_integral M f c"
  proof (cases "0  c")
    case True
    hence "AE x in M. 0  f x" using x space M. f x = c by simp
    thus ?thesis using ‹random_variable borel f True
      integralN M f = ennreal c by (simp add: has_bochner_integral_nn_integral)
  next
    case False
    let ?mf = "λw. - f w"
    have "AE x in M. 0  ?mf x" using x space M. f x = c False by simp
    hence "has_bochner_integral M ?mf (-c)" using ‹random_variable borel f False
      integralN M (λx. - f x) = ennreal (-c) by (simp add: has_bochner_integral_nn_integral)
    thus ?thesis using has_bochner_integral_minus by fastforce
  qed
qed

lemma (in infinite_cts_filtration) cst_nn_integral:
  fixes f::"bool streamreal"
  assumes "f  borel_measurable (F 0)"
  and "w. 0  f w"
  and "f (sconst True) = c"
shows "integralN M f = ennreal c" using assms cst_integral
  by (simp add: assms(1) has_bochner_integral_iff nn_integral_eq_integral)

lemma (in infinite_cts_filtration) suc_measurable:
  fixes f::"bool stream  'b::{t0_space}"
  assumes "f borel_measurable (F (Suc n))"
  shows "(λw. f (c ## w))  borel_measurable (F n)"
proof -
  have "(λw. f (c ## w))  borel_measurable (nat_filtration n)"
  proof (rule nat_filtration_comp_measurable)
    have "f borel_measurable M" using assms
      using measurable_from_subalg nat_filtration_subalgebra natural_filtration by blast
    hence "f borel_measurable (stream_space (measure_pmf (bernoulli_pmf p)))" using bernoulli unfolding bernoulli_stream_def by simp
    have "(λw. c ## w)  (stream_space (measure_pmf (bernoulli_pmf p))  M stream_space (measure_pmf (bernoulli_pmf p)))"
    proof (rule measurable_Stream)
      show "(λx. c)  stream_space (measure_pmf (bernoulli_pmf p)) M measure_pmf (bernoulli_pmf p)" by simp
      show "(λx. x)  stream_space (measure_pmf (bernoulli_pmf p)) M stream_space (measure_pmf (bernoulli_pmf p))" by simp
    qed
    hence "(λw. f (c ## w))  (stream_space (measure_pmf (bernoulli_pmf p))  M borel)" using f borel_measurable (stream_space (measure_pmf (bernoulli_pmf p)))
        measurable_comp[of "(λw. c ## w)" "stream_space (measure_pmf (bernoulli_pmf p))" "stream_space (measure_pmf (bernoulli_pmf p))" f borel]
      by simp
    thus "random_variable borel (λw. f (c ## w))" using  bernoulli unfolding bernoulli_stream_def by simp
    have "w. f (c ## (pseudo_proj_True n w)) = f (c##w)"
    proof
      fix w
      have "c## (pseudo_proj_True n w) = pseudo_proj_True (Suc n) (c##w)" unfolding pseudo_proj_True_def by simp
      hence "f (c ## (pseudo_proj_True n w)) = f (pseudo_proj_True (Suc n) (c##w))" by simp
      also have "... = f (c##w)" using assms nat_filtration_info[of f "Suc n"] natural_filtration
        by (metis comp_apply)
      finally show "f (c ## (pseudo_proj_True n w)) = f (c##w)" .
    qed
    thus "(λw. f (c ## w))  pseudo_proj_True n = (λw. f (c ## w))" by auto
  qed
  thus "(λw. f (c ## w))  borel_measurable (F n)" using natural_filtration by simp
qed




lemma (in infinite_cts_filtration) F_n_nn_integral_pos:
  fixes f::"bool streamreal"
  shows "f. (x. 0  f x)  f  borel_measurable (F n)  integralN M f =
    ( w range (pseudo_proj_True n). (emeasure M ((pseudo_proj_True n) -`{w}  space M)) *  ennreal (f w))"
proof (induct n)
  case 0
  have "range (pseudo_proj_True 0) = {sconst True}"
  proof
    have "w. pseudo_proj_True 0 w = sconst True"
    proof -
      fix w
      show "pseudo_proj_True 0 w = sconst True" unfolding pseudo_proj_True_def by simp
    qed
    thus "range (pseudo_proj_True 0)  {sconst True}" by auto
    show "{sconst True}  range (pseudo_proj_True 0)"
      using ‹range (pseudo_proj_True 0)  {sconst True} subset_singletonD by fastforce
  qed
  hence "(emeasure M ((pseudo_proj_True 0) -`{sconst True}  space M)) = ennreal 1"
    by (metis Int_absorb1 UNIV_I emeasure_eq_measure image_eqI prob_space subsetI vimage_eq)
  have "( w range (pseudo_proj_True 0). f w) = ( w {sconst True}. f w)" using ‹range (pseudo_proj_True 0) = {sconst True}
    sum.cong[of "range (pseudo_proj_True n)" "{sconst True}" f f] by simp
  also have "... = f (sconst True)" by simp
  finally have "( w range (pseudo_proj_True 0). f w) = f (sconst True)" .
  hence "( w range (pseudo_proj_True 0). (emeasure M ((pseudo_proj_True 0) -`{w}  space M)) * f w) = f (sconst True)"
    using (emeasure M ((pseudo_proj_True 0) -`{sconst True}  space M)) = ennreal 1
    by (simp add: ‹range (pseudo_proj_True 0) = {sconst True})
  thus "integralN M f = ( w range (pseudo_proj_True 0). (emeasure M ((pseudo_proj_True 0) -`{w}  space M)) * f w)"
    using 0  by (simp add:cst_nn_integral)
next
  case (Suc n)
  define BP where "BP = measure_pmf (bernoulli_pmf p)"
  have "integralN M f = integralN (stream_space BP) f" using bernoulli
    unfolding bernoulli_stream_def BP_def by simp
  also have "... = + x. + X. f (x ## X) stream_space BP BP"
  proof (rule prob_space.nn_integral_stream_space)
    show "prob_space BP" unfolding BP_def by (simp add: bernoulli bernoulli_stream_def
      prob_space.prob_space_stream_space prob_space_measure_pmf)
    have "f borel_measurable (stream_space BP)" using bernoulli Suc unfolding bernoulli_stream_def BP_def
      using measurable_from_subalg nat_filtration_subalgebra natural_filtration by blast
    thus "(λX. ennreal (f X))  borel_measurable (stream_space BP)" by simp
  qed
  also have "... = (λx. (+ X. f (x ## X) stream_space BP)) True * ennreal p +
    (λx. (+ X. f (x ## X) stream_space BP)) False * ennreal (1 -p)"
    using  p_gt_0 p_lt_1 unfolding BP_def by simp
  also have "... = (+ X. f (True ## X) stream_space BP) * p +
    (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) *  (f (False ## w))) * (1-p)"
  proof -
    define ff where "ff = (λw. f (False ## w))"
    have "x. 0  ff x" using Suc unfolding ff_def by simp
    moreover have "ff borel_measurable (F n)" using Suc unfolding ff_def by (simp add:suc_measurable)
    ultimately have "(+ x. ennreal (ff x) M) =
    (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * ennreal (ff w))"
      using Suc by simp
    thus ?thesis unfolding ff_def by (simp add: BP_def bernoulli bernoulli_stream_def)
  qed
  also have "... = (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) *  (f (True ## w))) * p +
    (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) *  (f (False ## w))) * (1-p)"
  proof -
    define ft where "ft = (λw. f (True ## w))"
    have "x. 0  ft x" using Suc unfolding ft_def by simp
    moreover have "ft borel_measurable (F n)" using Suc unfolding ft_def by (simp add:suc_measurable)
    ultimately have "(+ x. ennreal (ft x) M) =
    (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * ennreal (ft w))"
      using Suc by simp
    thus ?thesis unfolding ft_def by (simp add: BP_def bernoulli bernoulli_stream_def)
  qed
  also have "... = (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * p *  (f (True ## w))) +
    (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M)  *  (f (False ## w)))* (1-p)"
  proof -
    have "(wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) *  (f (True ## w))) * p =
      (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) *  (f (True ## w)) * p)"
      by (rule sum_distrib_right)
    also have "... = (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * p * (f (True ## w)))"
    proof (rule sum.cong, simp)
      fix w
      assume "w range (pseudo_proj_True n)"
      show "emeasure M (pseudo_proj_True n -` {w}  space M) * ennreal (f (True ## w)) * ennreal p =
         emeasure M (pseudo_proj_True n -` {w}  space M) * ennreal p * ennreal (f (True ## w))"
      proof -
        have "ennreal (f (True ## w)) * ennreal p = ennreal p * ennreal (f (True ## w))" by (simp add:mult.commute)
        hence "x. x * ennreal (f (True ## w)) * ennreal p = x * ennreal p * ennreal (f (True ## w))"
          by (simp add: semiring_normalization_rules(16))
        thus ?thesis by simp
      qed
    qed
    finally have "(wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) *  (f (True ## w))) * p =
      (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * p * (f (True ## w)))" .
    thus ?thesis by simp
  qed
  also have "... = (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * p *  (f (True ## w))) +
    (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * (1-p) *  (f (False ## w)))"
  proof -
    have "(wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) *  (f (False ## w))) * (1-p) =
      (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) *  (f (False ## w)) * (1-p))"
      by (rule sum_distrib_right)
    also have "... = (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * (1-p) * (f (False ## w)))"
    proof (rule sum.cong, simp)
      fix w
      assume "w range (pseudo_proj_True n)"
      show "emeasure M (pseudo_proj_True n -` {w}  space M) * ennreal (f (False ## w)) * ennreal (1-p) =
         emeasure M (pseudo_proj_True n -` {w}  space M) * ennreal (1-p) * ennreal (f (False ## w))"
      proof -
        have "ennreal (f (False ## w)) * ennreal (1-p) = ennreal (1-p) * ennreal (f (False ## w))" by (simp add:mult.commute)
        hence "x. x * ennreal (f (False ## w)) * ennreal (1-p) = x * ennreal (1-p) * ennreal (f (False ## w))"
          by (simp add: semiring_normalization_rules(16))
        thus ?thesis by simp
      qed
    qed
    finally have "(wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) *  (f (False ## w))) * (1-p) =
      (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * (1-p) * (f (False ## w)))" .
    thus ?thesis by simp
  qed
  also have "... = (y{y. w  range (pseudo_proj_True n). y = True ## w}. emeasure M (pseudo_proj_True n -` {stl y}  space M) * p *  (f (y))) +
    (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * (1-p) *  (f (False ## w)))"
  proof -
    have "(wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * p *  (f (True ## w))) =
      (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {stl (True##w)}  space M) * p *  (f (True ## w)))" by simp
    also have "... =
      (y{y. w  range (pseudo_proj_True n). y = True ## w}. emeasure M (pseudo_proj_True n -` {stl y}  space M) * p *  (f (y)))"
      by (rule reindex_pseudo_proj)
    finally have "(wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * p *  (f (True ## w))) =
      (y{y. w  range (pseudo_proj_True n). y = True ## w}. emeasure M (pseudo_proj_True n -` {stl y}  space M) * p *  (f (y)))" .
    thus ?thesis by simp
  qed
  also have "... = (y{y. w  range (pseudo_proj_True n). y = True ## w}. emeasure M (pseudo_proj_True n -` {stl y}  space M) * p *  (f (y))) +
    (y{y. w  range (pseudo_proj_True n). y = False ## w}. emeasure M (pseudo_proj_True n -` {stl y}  space M) * (1-p) *  (f (y)))"
  proof -
    have "(wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * (1-p) *  (f (False ## w))) =
      (wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {stl (False##w)}  space M) * (1-p) *  (f (False ## w)))" by simp
    also have "... =
      (y{y. w  range (pseudo_proj_True n). y = False ## w}. emeasure M (pseudo_proj_True n -` {stl y}  space M) * (1-p) *  (f (y)))"
      by (rule reindex_pseudo_proj)
    finally have "(wrange (pseudo_proj_True n). emeasure M (pseudo_proj_True n -` {w}  space M) * (1-p) *  (f (False ## w))) =
      (y{y. w  range (pseudo_proj_True n). y = False ## w}. emeasure M (pseudo_proj_True n -` {stl y}  space M) * (1-p) *  (f (y)))" .
    thus ?thesis by simp
  qed
  also have "... = (y{y. w  range (pseudo_proj_True n). y = True ## w}. (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y}  space M) *  (f (y))) +
    (y{y. w  range (pseudo_proj_True n). y = False ## w}. emeasure M (pseudo_proj_True n -` {stl y}  space M) * (1-p) *  (f (y)))"
  proof -
    have "y {y. w  range (pseudo_proj_True n). y = True ## w}. emeasure M (pseudo_proj_True n -` {stl y}  space M) * p =
      prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y}  space M)"
    proof
      fix y
      assume "y {y. w  range (pseudo_proj_True n). y = True ## w}"
      hence "w  range (pseudo_proj_True n). y = True ## w" by simp
      from this obtain w where "w range (pseudo_proj_True n)" and "y = True ## w" by auto
      have "emeasure M (pseudo_proj_True n -` {stl y}  space M) * p = p *emeasure M (pseudo_proj_True n -` {stl y}  space M)"
        by (simp add:mult.commute)
      also have "... = prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y}  space M)" using y = True ## w
        unfolding prob_component_def by simp
      finally show "emeasure M (pseudo_proj_True n -` {stl y}  space M) * p =
        prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y}  space M)" .
    qed
    thus ?thesis by auto
  qed
  also have "... = (y{y. w  range (pseudo_proj_True n). y = True ## w}. (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y}  space M) *  (f (y))) +
    (y{y. w  range (pseudo_proj_True n). y = False ## w}. (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y}  space M) *  (f (y)))"
  proof -
    have "y {y. w  range (pseudo_proj_True n). y = False ## w}. emeasure M (pseudo_proj_True n -` {stl y}  space M) * (1-p) =
      prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y}  space M)"
    proof
      fix y
      assume "y {y. w  range (pseudo_proj_True n). y = False ## w}"
      hence "w  range (pseudo_proj_True n). y = False ## w" by simp
      from this obtain w where "w range (pseudo_proj_True n)" and "y = False ## w" by auto
      have "emeasure M (pseudo_proj_True n -` {stl y}  space M) * (1-p) = (1-p) *emeasure M (pseudo_proj_True n -` {stl y}  space M)"
        by (simp add:mult.commute)
      also have "... = prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y}  space M)" using y = False ## w
        unfolding prob_component_def by simp
      finally show "emeasure M (pseudo_proj_True n -` {stl y}  space M) * (1-p) =
        prob_component p y 0 * emeasure M (pseudo_proj_True n -` {stl y}  space M)" .
    qed
    thus ?thesis by auto
  qed
  also have "... = (y{y. w  range (pseudo_proj_True n). y = True ## w}. emeasure M {z  space M. xpseudo_proj_True n -` {stl y}. z = True ## x} *  (f y)) +
    (y{y. w  range (pseudo_proj_True n). y = False ## w}. (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y}  space M) *  (f (y)))"
  proof -
    have "(y | wrange (pseudo_proj_True n). y = True ## w.
       ennreal (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y}  space M) * (f y)) =
      (y{y. w  range (pseudo_proj_True n). y = True ## w}. emeasure M {z  space M. xpseudo_proj_True n -` {stl y}. z = True ## x} * (f y))"
    proof (rule sum.cong, simp)
      fix xx
      assume "xx  {y. wrange (pseudo_proj_True n). y = True ## w}"
      hence "wrange (pseudo_proj_True n). xx = True ## w" by simp
      from this obtain ww where "wwrange (pseudo_proj_True n)" and "xx = True## ww" by auto
      have "ennreal (prob_component p (True##ww) 0) * emeasure M (pseudo_proj_True n -` {ww}  space M) =
         emeasure M {z  space M. xpseudo_proj_True n -` {ww}. z = True ## x}" using wwrange (pseudo_proj_True n)
        by (rule pseudo_proj_element_prob_pref[symmetric])
      thus "ennreal (prob_component p xx 0) * emeasure M (pseudo_proj_True n -` {stl xx}  space M) * (f xx) =
         emeasure M {z  space M. xpseudo_proj_True n -` {stl xx}. z = True ## x} * (f xx)" using xx = True##ww  by simp
    qed
    thus ?thesis by simp
  qed
  also have "... = (y{y. w  range (pseudo_proj_True n). y = True ## w}. emeasure M {z  space M. xpseudo_proj_True n -` {stl y}. z = True ## x} *  (f y)) +
    (y{y. w  range (pseudo_proj_True n). y = False ## w}. emeasure M {z  space M. xpseudo_proj_True n -` {stl y}. z = False ## x} *  (f y))"
  proof -
    have "(y | wrange (pseudo_proj_True n). y = False ## w.
       ennreal (prob_component p y 0) * emeasure M (pseudo_proj_True n -` {stl y}  space M) * (f y)) =
      (y{y. w  range (pseudo_proj_True n). y = False ## w}. emeasure M {z  space M. xpseudo_proj_True n -` {stl y}. z = False ## x} * (f y))"
    proof (rule sum.cong, simp)
      fix xx
      assume "xx  {y. wrange (pseudo_proj_True n). y = False ## w}"
      hence "wrange (pseudo_proj_True n). xx = False ## w" by simp
      from this obtain ww where "wwrange (pseudo_proj_True n)" and "xx = False## ww" by auto
      have "ennreal (prob_component p (False##ww) 0) * emeasure M (pseudo_proj_True n -` {ww}  space M) =
         emeasure M {z  space M. xpseudo_proj_True n -` {ww}. z = False ## x}" using wwrange (pseudo_proj_True n)
        by (rule pseudo_proj_element_prob_pref[symmetric])
      thus "ennreal (prob_component p xx 0) * emeasure M (pseudo_proj_True n -` {stl xx}  space M) * (f xx) =
         emeasure M {z  space M. xpseudo_proj_True n -` {stl xx}. z = False ## x} * (f xx)" using xx = False##ww  by simp
    qed
    thus ?thesis by simp
  qed
  also have "... = (w range (pseudo_proj_True n). emeasure M {z  space M. xpseudo_proj_True n -` {w}. z = True ## x} *  (f (True##w))) +
    (w  range (pseudo_proj_True n). emeasure M {z  space M. xpseudo_proj_True n -` {w}. z = False ## x} *  (f (False##w)))"
  proof -
    have "c. (y{y. w  range (pseudo_proj_True n). y = c ## w}. emeasure M {z  space M. xpseudo_proj_True n -` {stl y}. z = c ## x} *  (f y)) =
      (w range (pseudo_proj_True n). emeasure M {z  space M. xpseudo_proj_True n -` {w}. z = c ## x} *  (f (c##w)))"
    proof -
      fix c
      have "(y{y. w  range (pseudo_proj_True n). y = c ## w}. emeasure M {z  space M. xpseudo_proj_True n -` {stl y}. z = c ## x} *  (f y)) =
      (w range (pseudo_proj_True n). emeasure M {z  space M. xpseudo_proj_True n -` {stl (c##w)}. z = c ## x} *  (f (c##w)))"
        by (rule reindex_pseudo_proj[symmetric])
      also have "... = (w range (pseudo_proj_True n). emeasure M {z  space M. xpseudo_proj_True n -` {w}. z = c ## x} *  (f (c##w)))"
        by simp
      finally show "(y{y. w  range (pseudo_proj_True n). y = c ## w}. emeasure M {z  space M. xpseudo_proj_True n -` {stl y}. z = c ## x} *  (f y)) =
        (w range (pseudo_proj_True n). emeasure M {z  space M. xpseudo_proj_True n -` {w}. z = c ## x} *  (f (c##w)))" .
    qed
    thus ?thesis by auto
  qed
  also have "... = (w {w. w range (pseudo_proj_True (Suc n))  w!!0 = True}. emeasure M (pseudo_proj_True (Suc n) -` {w}  (space M)) *  (f w)) +
    (w {w. w range (pseudo_proj_True (Suc n))  w!!0 = False}. emeasure M (pseudo_proj_True (Suc n) -` {w}  (space M)) *  (f w))"
  proof -
    have "c. (w range (pseudo_proj_True n). emeasure M {z  space M. xpseudo_proj_True n -` {w}. z = c ## x} *  (f (c##w))) =
      (w {w. w range (pseudo_proj_True (Suc n))  w!!0 = c}. emeasure M (pseudo_proj_True (Suc n) -` {w}  (space M)) *  (f w))"
    proof -
      fix c
      show "(w range (pseudo_proj_True n). emeasure M {z  space M. xpseudo_proj_True n -` {w}. z = c ## x} *  (f (c##w))) =
        (w {w. w range (pseudo_proj_True (Suc n))  w!!0 = c}. emeasure M (pseudo_proj_True (Suc n) -` {w}  (space M)) *  (f w))"
      proof (rule sum.reindex_cong)
        show "inj_on stl {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}"
        proof
          fix x y
          assume "x  {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}"
            and "y  {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}"
            and "stl x = stl y"
          have "x!!0 = c" using x  {w  range (pseudo_proj_True (Suc n)). w !! 0 = c} by simp
          moreover have "y!!0 = c" using y  {w  range (pseudo_proj_True (Suc n)). w !! 0 = c} by simp
          ultimately show "x = y" using ‹stl x=  stl y
            by (smt snth.simps(1) stream_eq_Stream_iff)
            (*by (metis (full_types, hide_lams)  pmf_bernoulli_True snth.simps(1) stream_eq_Stream_iff) *)
        qed
        show "range (pseudo_proj_True n) = stl ` {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}"
        proof
          show "range (pseudo_proj_True n)  stl ` {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}"
          proof
            fix x
            assume "x range (pseudo_proj_True n)"
            hence "pseudo_proj_True n x = x" using pseudo_proj_True_proj by auto
            have "pseudo_proj_True (Suc n) (c##x) = c##x"
            proof -
              have "pseudo_proj_True (Suc n) (c##x) = c ## pseudo_proj_True n x" using pseudo_proj_True_Suc_prefix[of n "c##x"]
                by simp
              also have "... = c## x" using ‹pseudo_proj_True n x = x by simp
              finally show ?thesis .
            qed
            hence "c##x range (pseudo_proj_True (Suc n))" by (simp add: pseudo_proj_True_img)
            thus "x stl`{w  range (pseudo_proj_True (Suc n)). w !! 0 = c}"
            proof -
              have "s. (s  range (pseudo_proj_True (Suc n))  s !! 0 = c)  stl s = x"
                by (metis (no_types) c ## x  range (pseudo_proj_True (Suc n)) snth.simps(1) stream.sel(1) stream.sel(2))
              then show ?thesis
                by force
            qed
          qed
          show "stl ` {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}  range (pseudo_proj_True n)"
          proof
            fix x
            assume "x stl ` {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}"
            hence " w {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}. x = stl w" by auto
            from this obtain w where "w  {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}" and "x = stl w" by auto
            have "w range (pseudo_proj_True (Suc n))" and "w!!0 = c" using w  {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}
              by auto
            have "c##x = w" using x = stl w w!!0 = c by force
            also have "... = pseudo_proj_True (Suc n) w" using w range (pseudo_proj_True (Suc n))
              using pseudo_proj_True_proj by auto
            also have "... = c ## pseudo_proj_True n x" using x = stl w w!!0 = c by (simp add:pseudo_proj_True_Suc_prefix)
            finally have "c##x = c## pseudo_proj_True n x" .
            hence "x = pseudo_proj_True n x" by simp
            thus "x range (pseudo_proj_True n)" by auto
          qed
        qed
        show "x. x  {w  range (pseudo_proj_True (Suc n)). w !! 0 = c} 
         emeasure M {z  space M. xpseudo_proj_True n -` {stl x}. z = c ## x} * ennreal (f (c ## stl x)) =
         emeasure M (pseudo_proj_True (Suc n) -` {x}  space M) * ennreal (f x)"
        proof -
          fix w
          assume "w  {w  range (pseudo_proj_True (Suc n)). w !! 0 = c}"
          hence "w  range (pseudo_proj_True (Suc n))" and "w !! 0 = c" by auto
          have "{z  space M. xpseudo_proj_True n -` {stl w}. z = c ## x} = (pseudo_proj_True (Suc n) -` {w}  space M)"
          proof
            show "{z  space M. xpseudo_proj_True n -` {stl w}. z = c ## x}  pseudo_proj_True (Suc n) -` {w}  space M"
            proof
              fix z
              assume "z  {z  space M. xpseudo_proj_True n -` {stl w}. z = c ## x}"
              hence "xpseudo_proj_True n -` {stl w}. z = c ## x" and "z space M" by auto
              from xpseudo_proj_True n -` {stl w}. z = c ## x obtain x where "xpseudo_proj_True n -` {stl w}"
                and "z = c##x" by auto
              have "pseudo_proj_True (Suc n) z = c ## pseudo_proj_True n x" using z = c##x
                by (simp add:pseudo_proj_True_Suc_prefix)
              also have "... = c## stl w" using xpseudo_proj_True n -` {stl w} by simp
              also have "... = w" using w !! 0 = c by force
              finally have "pseudo_proj_True (Suc n) z = w" .
              thus "z pseudo_proj_True (Suc n) -` {w}  space M" using z space M by auto
            qed
            show "pseudo_proj_True (Suc n) -` {w}  space M  {z  space M. xpseudo_proj_True n -` {stl w}. z = c ## x}"
            proof
              fix z
              assume "z pseudo_proj_True (Suc n) -` {w}  space M"
              hence "z space M" and "pseudo_proj_True (Suc n) z = w" by auto
              hence "stl w = stl (pseudo_proj_True (Suc n) z)" by simp
              also have "... = pseudo_proj_True n (stl z)" by (simp add: pseudo_proj_True_Suc_prefix)
              finally have "stl w = pseudo_proj_True n (stl z)" .
              hence "stl z  pseudo_proj_True n -` {stl w}" by simp
              have "z!!0 ## pseudo_proj_True n (stl z) = w" using pseudo_proj_True_Suc_prefix
                ‹pseudo_proj_True (Suc n) z = w by simp
              also have "... = c## (stl w)" using w!!0 = c by force
              finally have "z!!0 ## pseudo_proj_True n (stl z) = c## (stl w)" .
              hence "z!!0 = c" by simp
              hence "z =c## (stl z)" by force
              thus "z {z  space M. xpseudo_proj_True n -` {stl w}. z = c ## x}" using z space M
                ‹stl z  pseudo_proj_True n -` {stl w} by auto
            qed
          qed
          hence "emeasure M {z  space M. xpseudo_proj_True n -` {stl w}. z = c ## x} * ennreal (f (c ## stl w)) =
            emeasure M (pseudo_proj_True (Suc n) -` {w}  space M) * ennreal (f (c ## stl w))" by simp
          also have "... = emeasure M (pseudo_proj_True (Suc n) -` {w}  space M) * ennreal (f w)" using w!!0 = c by force
          finally show "emeasure M {z  space M. xpseudo_proj_True n -` {stl w}. z = c ## x} * ennreal (f (c ## stl w)) =
            emeasure M (pseudo_proj_True (Suc n) -` {w}  space M) * ennreal (f w)" .
        qed
      qed
    qed
    thus ?thesis by simp
  qed
  also have "... = (w {w  range (pseudo_proj_True (Suc n)). w !! 0 = True} 
    {w  range (pseudo_proj_True (Suc n)). w !! 0 = False}.
    emeasure M (pseudo_proj_True (Suc n) -` {w}  space M) * ennreal (f w))"
  proof (rule sum.union_disjoint[symmetric])
    show "finite {w  range (pseudo_proj_True (Suc n)). w !! 0 = True}" by (simp add: pseudo_proj_True_finite_image)
    show "finite {w  range (pseudo_proj_True (Suc n)). w !! 0 = False}" by (simp add: pseudo_proj_True_finite_image)
    show "{w  range (pseudo_proj_True (Suc n)). w !! 0 = True}  {w  range (pseudo_proj_True (Suc n)). w !! 0 = False} = {}"
      by auto
  qed
  also have "... = (w range (pseudo_proj_True (Suc n)).emeasure M (pseudo_proj_True (Suc n) -` {w}  space M) * ennreal (f w))"
  proof (rule sum.cong)
    show "{w  range (pseudo_proj_True (Suc n)). w !! 0 = True}  {w  range (pseudo_proj_True (Suc n)). w !! 0 = False} =
    range (pseudo_proj_True (Suc n))"
    proof
      show "{w  range (pseudo_proj_True (Suc n)). w !! 0 = True}  {w  range (pseudo_proj_True (Suc n)). w !! 0 = False}
         range (pseudo_proj_True (Suc n))" by auto
      show "range (pseudo_proj_True (Suc n))
         {w  range (pseudo_proj_True (Suc n)). w !! 0 = True} 
        {w  range (pseudo_proj_True (Suc n)). w !! 0 = False}"
        by (simp add: subsetI)
    qed
  qed simp
  finally show "integralN M f =
    (w range (pseudo_proj_True (Suc n)). emeasure M (pseudo_proj_True (Suc n) -` {w}  space M) * ennreal (f w))" .
qed


lemma (in infinite_cts_filtration) F_n_integral_pos:
  fixes f::"bool streamreal"
  assumes "f borel_measurable (F n)"
  and "w. 0  f w"
  shows "has_bochner_integral M f
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) *   (f w))"
proof -
  have "integralN M f = ( w range (pseudo_proj_True n). (emeasure M ((pseudo_proj_True n) -`{w}  space M)) *   (f w))"
    using assms by (simp add: F_n_nn_integral_pos)
  have "integralL M f = enn2real (integralN M f)"
  proof (rule integral_eq_nn_integral)
    show "AE x in M. 0 f x" using assms by simp
    show "random_variable borel f" using assms
      using measurable_from_subalg nat_filtration_subalgebra natural_filtration by blast
  qed
  also have "... = enn2real ( w range (pseudo_proj_True n). (emeasure M ((pseudo_proj_True n) -`{w}  space M)) *   (f w))"
    using assms by (simp add: F_n_nn_integral_pos)
  also have "... = ( w range (pseudo_proj_True n). enn2real ((emeasure M ((pseudo_proj_True n) -`{w}  space M)) *   (f w)))"
  proof (rule enn2real_sum)
    show "finite (range (pseudo_proj_True n))" by (simp add: pseudo_proj_True_finite_image)
    show "w. w  range (pseudo_proj_True n)  emeasure M (pseudo_proj_True n -` {w}  space M) * ennreal (f w) < "
    proof -
      fix w
      assume "w range (pseudo_proj_True n)"
      show "emeasure M (pseudo_proj_True n -` {w}  space M) * ennreal (f w) < "
        by (simp add: emeasure_eq_measure ennreal_mult_less_top)
    qed
  qed
  also have "... = ( w range (pseudo_proj_True n).  ((measure M ((pseudo_proj_True n) -`{w}  space M)) *   (f w)))"
    by (simp add: Sigma_Algebra.measure_def assms(2) enn2real_mult)
  finally have "integralL M f =( w range (pseudo_proj_True n).  ((measure M ((pseudo_proj_True n) -`{w}  space M)) *   (f w)))" .
  moreover have "integrable M f"
  proof (rule integrableI_nn_integral_finite)
    show "random_variable borel f" using assms
      using measurable_from_subalg nat_filtration_subalgebra natural_filtration by blast
    show "AE x in M. 0  f x" using assms by simp
    have "(+ x. ennreal (f x) M) = ( w range (pseudo_proj_True n). (emeasure M ((pseudo_proj_True n) -`{w}  space M)) *   (f w))"
      using assms by (simp add: F_n_nn_integral_pos)
    also have "... = ( w range (pseudo_proj_True n). ennreal (measure M ((pseudo_proj_True n) -`{w}  space M) *   (f w)))"
    proof (rule sum.cong, simp)
      fix x
      assume "x range (pseudo_proj_True n)"
      thus "emeasure M (pseudo_proj_True n -` {x}  space M) * ennreal (f x) =
         ennreal (prob (pseudo_proj_True n -` {x}  space M) * f x)"
        using assms(2) emeasure_eq_measure ennreal_mult'' by auto
    qed
    also have "... = ennreal ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M) *   (f w)))"
    proof (rule ennreal_sum)
      show "finite (range (pseudo_proj_True n))" by (simp add: pseudo_proj_True_finite_image)
      show "w. 0  prob (pseudo_proj_True n -` {w}  space M) * f w"
        using assms(2) measure_nonneg zero_le_mult_iff by blast
    qed
    finally show "(+ x. ennreal (f x) M) =
      ennreal ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M) *   (f w)))" .
  qed
  ultimately show ?thesis using has_bochner_integral_iff by blast
qed


lemma (in infinite_cts_filtration) F_n_integral:
  fixes f::"bool streamreal"
  assumes "f borel_measurable (F n)"
  shows "has_bochner_integral M f
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) * (f w))"
proof -
  define fpos where "fpos = (λw. max 0 (f w))"
  define fneg where "fneg = (λw. max 0 (-f w))"
  have "w. 0  fpos w" unfolding fpos_def by simp
  have "w. 0  fneg w" unfolding fneg_def by simp
  have "fpos  borel_measurable (F n)" using assms unfolding fpos_def by simp
  have "fneg  borel_measurable (F n)" using assms unfolding fneg_def by simp
  have "has_bochner_integral M fpos
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) *   (fpos w))"
    using fpos borel_measurable (F n) w. 0  fpos w by (simp add: F_n_integral_pos)
  moreover have "has_bochner_integral M fneg
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) *   (fneg w))"
    using fneg borel_measurable (F n) w. 0  fneg w by (simp add: F_n_integral_pos)
  ultimately have posd: "has_bochner_integral M (λw. fpos w - fneg w)
    (( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) *   (fpos w)) -
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) *   (fneg w)))"
    by (simp add:has_bochner_integral_diff)
  have "(( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) *   (fpos w)) -
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) *   (fneg w))) =
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M) * fpos w -
      (measure M ((pseudo_proj_True n) -`{w}  space M)) * fneg w))"
    by (rule sum_subtractf[symmetric])
  also have "... =
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M) * (fpos w - fneg w)))"
  proof (rule sum.cong, simp)
    fix x
    assume "x range (pseudo_proj_True n)"
    show "prob (pseudo_proj_True n -` {x}  space M) * fpos x - prob (pseudo_proj_True n -` {x}  space M) * fneg x =
         prob (pseudo_proj_True n -` {x}  space M) * (fpos x - fneg x)"
      by (rule right_diff_distrib[symmetric])
  qed
  also have "... =
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M) * f w))"
  proof (rule sum.cong, simp)
    fix x
    assume "x range (pseudo_proj_True n)"
    show "prob (pseudo_proj_True n -` {x}  space M) * (fpos x - fneg x) = prob (pseudo_proj_True n -` {x}  space M) * f x"
      unfolding fpos_def fneg_def by auto
  qed
  finally have "(( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) *   (fpos w)) -
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) *   (fneg w))) =
    ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M) * f w))" .
  hence "has_bochner_integral M (λw. fpos w - fneg w) ( w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M) * f w))"
    using posd by simp
  moreover have "w. fpos w - fneg w = f w" unfolding fpos_def fneg_def by auto
  ultimately show ?thesis using has_bochner_integral_diff by simp
qed

lemma (in infinite_cts_filtration) F_n_integral_prob_comp:
fixes f::"bool streamreal"
  assumes "f borel_measurable (F n)"
  shows "has_bochner_integral M f
    ( w range (pseudo_proj_True n). (prod (prob_component p w) {0..<n}) * (f w))"
proof -
  have " w range (pseudo_proj_True n). (measure M ((pseudo_proj_True n) -`{w}  space M)) * f w =
    (prod (prob_component p w) {0..<n}) * (f w)"
  proof
    fix w
    assume "w range (pseudo_proj_True n)"
    thus "prob (pseudo_proj_True n -` {w}  space M) * f w = prod (prob_component p w) {0..<n} * f w"
      using bernoulli_stream_pseudo_prob bernoulli p_lt_1 p_gt_0 by simp
  qed
  thus ?thesis using F_n_integral assms by (metis (no_types, lifting) sum.cong)
qed

lemma (in infinite_cts_filtration) expect_prob_comp:
fixes f::"bool streamreal"
  assumes "f borel_measurable (F n)"
  shows "expectation f =
    ( w range (pseudo_proj_True n). (prod (prob_component p w) {0..<n}) * (f w))"
  using assms F_n_integral_prob_comp has_bochner_integral_iff by blast

lemma sum_union_disjoint':
  assumes "finite A"
    and "finite B"
    and "A  B = {}"
    and "A  B = C"
  shows "sum g C = sum g A + sum g B"
  using sum.union_disjoint[OF assms(1-3)] and assms(4) by auto

lemma (in infinite_cts_filtration) borel_Suc_expectation:
  fixes f::"bool stream real"
  assumes "f borel_measurable (F (Suc n))"
  and "g measurable (F n) N"
  and "set_discriminating n g N"
  and "g -` {g z}  sets (F n)"
  and "y z. (g y = g z  snth y n = snth z n)  f y = f z"
  shows "expectation (λx. f x * indicator (g -` {g z}) x) =
    prob (g -` {g z}) * (p * f (pseudo_proj_True n z) +
     (1 -p) * f (pseudo_proj_False n z))"
proof -
  define expind where "expind = (λx. f x * indicator (g -` {g z}) x)"
  have "expind borel_measurable (F (Suc n))" unfolding expind_def
  proof (rule borel_measurable_times, (simp add:assms(1,2)))
    show "indicator (g -` {g z})  borel_measurable (F (Suc n))"
    proof (rule borel_measurable_indicator)
      have "g -` {g z}  sets (nat_filtration n)"
        using assms nat_filtration_borel_measurable_singleton natural_filtration by simp
      hence "g -` {g z}  sets (F n)" using natural_filtration by simp
      thus "g -` {g z}  sets (F (Suc n))"
        using nat_filtration_Suc_sets natural_filtration by blast
    qed
  qed
  hence "expectation expind =
    ( w range (pseudo_proj_True (Suc n)). (measure M ((pseudo_proj_True (Suc n)) -`{w}  space M)) * (expind w))"
    by (simp add:F_n_integral has_bochner_integral_integral_eq)
  also have "... = ( w range (pseudo_proj_True (Suc n))  g -` {g z}.
    (measure M ((pseudo_proj_True (Suc n)) -`{w}  space M)) * (expind w)) +
    ( w range (pseudo_proj_True (Suc n)) - g -` {g z}.
    (measure M ((pseudo_proj_True (Suc n)) -`{w}  space M)) * (expind w))"
    by (simp add: Int_Diff_Un Int_Diff_disjoint assms sum_union_disjoint' pseudo_proj_True_finite_image)
  also have "... = ( w range (pseudo_proj_True (Suc n))  g -` {g z}.
    (measure M ((pseudo_proj_True (Suc n)) -`{w}  space M)) * (expind w))"
  proof -
    have "w range (pseudo_proj_True (Suc n)) - g -` {g z}. expind w = 0"
    proof
      fix w
      assume "w range (pseudo_proj_True (Suc n)) - g -` {g z}"
      thus "expind w = 0" unfolding expind_def by simp
    qed
    thus ?thesis by simp
  qed
  also have "... = ( w range (pseudo_proj_True (Suc n))  g -` {g z}.
    (measure M ((pseudo_proj_True (Suc n)) -`{w}  space M)) * f w)"
  proof -
    have "w range (pseudo_proj_True (Suc n))  g -` {g z}. expind w = f w"
    proof
      fix w
      assume "w range (pseudo_proj_True (Suc n))  g -` {g z}"
      hence "w g -`{g z}" by simp
      thus "expind w = f w" unfolding expind_def by simp
    qed
    thus ?thesis by simp
  qed
  also have "... = ( w (pseudo_proj_True n) ` (g -` {g z})  (pseudo_proj_False n) ` (g -` {g z}).
    (measure M ((pseudo_proj_True (Suc n)) -`{w}  space M)) * f w)" using f_borel_Suc_preimage[of g] assms(1,2, 3) by auto
  also have "... = ( w (pseudo_proj_True n) ` (g -` {g z}).
    (measure M ((pseudo_proj_True (Suc n)) -`{w}  space M)) * f w) +
    (w (pseudo_proj_False n) ` (g -` {g z}).
    (measure M ((pseudo_proj_True (Suc n)) -`{w}  space M)) * f w)"
  proof (rule sum_union_disjoint')
    show "finite (pseudo_proj_True n ` g -` {g z})"
    proof -
      have "finite (range (pseudo_proj_True n))" by (simp add: pseudo_proj_True_finite_image)
      moreover have "pseudo_proj_True n ` g -` {g z}  range (pseudo_proj_True n)"
        by (simp add: image_mono)
      ultimately show ?thesis by (simp add:finite_subset)
    qed
    show "finite (pseudo_proj_False n ` g -` {g z})"
    proof -
      have "finite (range (pseudo_proj_False n))"
        by (metis image_subsetI infinite_super proj_rep_set proj_rep_set_finite pseudo_proj_True_Suc_False_proj rangeI)
      moreover have "pseudo_proj_False n ` g -` {g z}  range (pseudo_proj_False n)"
        by (simp add: image_mono)
      ultimately show ?thesis by (simp add:finite_subset)
    qed
    show "pseudo_proj_True n ` g -` {g z}  pseudo_proj_False n ` g -` {g z} = {}"
    proof (rule ccontr)
      assume "pseudo_proj_True n ` g -` {g z}  pseudo_proj_False n ` g -` {g z}  {}"
      hence "y. y pseudo_proj_True n ` g -` {g z}  pseudo_proj_False n ` g -` {g z}" by auto
      from this obtain y where "y pseudo_proj_True n ` g -` {g z}" and "y pseudo_proj_False n ` g -` {g z}" by auto
      have "yt. yt g -`{g z}  y = pseudo_proj_True n yt" using y pseudo_proj_True n ` g -` {g z} by auto
      from this obtain yt where "y = pseudo_proj_True n yt" by auto
      have "yf. yf g -`{g z}  y = pseudo_proj_False n yf" using y pseudo_proj_False n ` g -` {g z} by auto
      from this obtain yf where "y = pseudo_proj_False n yf" by auto
      have "snth y n = True" using y = pseudo_proj_True n yt unfolding pseudo_proj_True_def by simp
      moreover have "snth y n = False" using y = pseudo_proj_False n yf unfolding pseudo_proj_False_def by simp
      ultimately show False by simp
    qed
  qed simp
  also have "... = (wpseudo_proj_True n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w}  space M) * f (pseudo_proj_True n z)) +
  (wpseudo_proj_False n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w}  space M) * f w)"
  proof -
    define zt where "zt = pseudo_proj_True n z"
    have eqw: "w. wpseudo_proj_True n ` g -` {g z}  (g w = g zt  snth w n = snth zt n)"
    proof
      fix w
      assume "w pseudo_proj_True n ` g -` {g z}"
      hence "y. w = pseudo_proj_True n y  g y = g z" by auto
      from this obtain yt where "w = pseudo_proj_True n yt" and "g yt = g z" by auto
      have "g w= g yt" using w = pseudo_proj_True n yt nat_filtration_not_borel_info[of g] natural_filtration
        assms by (metis comp_apply)
      also have "... = g zt"  using assms using nat_filtration_not_borel_info[of g] natural_filtration g yt = g z
        unfolding zt_def by (metis comp_apply)
      finally show "g w = g zt" .
      show "w !! n = zt !! n" using w = pseudo_proj_True n yt unfolding zt_def pseudo_proj_True_def by simp
    qed
    hence "w. wpseudo_proj_True n ` g -` {g z}  f w = f zt"
    proof
      fix w
      assume "w  pseudo_proj_True n ` g -` {g z}"
      hence "g w = g zt  snth w n = snth zt n" using eqw [of w] by simp
      thus "f w = f zt" using assms(5) by blast
    qed
    thus ?thesis by simp
  qed
  also have "... = (wpseudo_proj_True n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w}  space M) * f (pseudo_proj_True n z)) +
  (wpseudo_proj_False n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w}  space M) * f (pseudo_proj_False n z))"
  proof -
    define zf where "zf = pseudo_proj_False n z"
    have eqw: "w. wpseudo_proj_False n ` g -` {g z}  (g w = g zf  snth w n = snth zf n)"
    proof
      fix w
      assume "w pseudo_proj_False n ` g -` {g z}"
      hence "y. w = pseudo_proj_False n y  g y = g z" by auto
      from this obtain yf where "w = pseudo_proj_False n yf" and "g yf = g z" by auto
      have "g w= g yf" using w = pseudo_proj_False n yf nat_filtration_not_borel_info'[of g] natural_filtration
        assms by (metis comp_apply)
      also have "... = g zf"  using assms using nat_filtration_not_borel_info'[of g] natural_filtration g yf = g z
        unfolding zf_def by (metis comp_apply)
      finally show "g w = g zf" .
      show "w !! n = zf !! n" using w = pseudo_proj_False n yf unfolding zf_def pseudo_proj_False_def by simp
    qed
    hence "w. wpseudo_proj_False n ` g -` {g z}  f w = f zf"
    proof
      fix w
      assume "w pseudo_proj_False n ` g -` {g z}"
      hence "g w = g zf  snth w n = snth zf n" using eqw [of w] by simp
      thus "f w = f zf" using assms by blast
    qed
    thus ?thesis by simp
  qed
  also have "... = (wpseudo_proj_True n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w}  space M)) * f (pseudo_proj_True n z) +
    (wpseudo_proj_False n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w}  space M)) * f (pseudo_proj_False n z)"
    by (simp add: sum_distrib_right)
  also have "... = (wpseudo_proj_True n ` g -` {g z}. prob ({x. stake n x = stake n w}) * p) * f (pseudo_proj_True n z) +
    (wpseudo_proj_False n ` g -` {g z}. prob (pseudo_proj_True (Suc n) -` {w}  space M)) * f (pseudo_proj_False n z)"
  proof -
    have "w. wpseudo_proj_True n ` g -` {g z}  (prob (pseudo_proj_True (Suc n) -` {w}) =
      (prob ({x. stake n x = stake n w})) * p)"
    proof -
      fix w
      assume "wpseudo_proj_True n ` g -` {g z}"
      hence "y. w = pseudo_proj_True n y  g y = g z" by auto
      from this obtain yt where "w = pseudo_proj_True n yt" and "g yt = g z" by auto
      hence "snth w n" unfolding pseudo_proj_True_def by simp
      have "pseudo_proj_True (Suc n) w = w" using w = pseudo_proj_True n yt
        by (simp add: pseudo_proj_True_Suc_proj)
      hence "pseudo_proj_True (Suc n) -` {w} = {x. stake (Suc n) x = stake (Suc n) w}" using pseudo_proj_True_preimage_stake
        by simp
      hence "prob (pseudo_proj_True (Suc n) -` {w}) = prob {x. stake n x = stake n w} * prob_component p w n"
        using bernoulli_stream_element_prob_rec' bernoulli bernoulli_stream_space p_lt_1 p_gt_0 by simp
      also have "... = prob {x. stake n x = stake n w} * p" using ‹snth w n unfolding prob_component_def by simp
      finally show "prob (pseudo_proj_True (Suc n) -` {w}) = prob {x. stake n x = stake n w} * p" .
    qed
    thus ?thesis using bernoulli bernoulli_stream_space by simp
  qed
  also have "... = (wpseudo_proj_True n ` g -` {g z}. prob ({x. stake n x = stake n w}) * p) * f (pseudo_proj_True n z) +
    (wpseudo_proj_False n ` g -` {g z}. prob {x. stake n x = stake n w} * (1 -p)) * f (pseudo_proj_False n z)"
  proof -
    have "w. wpseudo_proj_False n ` g -` {g z}  (prob (pseudo_proj_True (Suc n) -` {w}  space M) =
      (prob {x. stake n x = stake n w}) * (1-p))"
    proof -
      fix w
      assume "wpseudo_proj_False n ` g -` {g z}"
      hence "y. w = pseudo_proj_False n y  g y = g z" by auto
      from this obtain yt where "w = pseudo_proj_False n yt" and "g yt = g z" by auto
      hence "¬snth w n" unfolding pseudo_proj_False_def by simp
      have "pseudo_proj_True (Suc n) w = w" using w = pseudo_proj_False n yt
        by (simp add: pseudo_proj_True_Suc_False_proj)
      hence "pseudo_proj_True (Suc n) -`{w} = {x. stake (Suc n) x = stake (Suc n) w}" using pseudo_proj_True_preimage_stake
        by simp
      hence "prob (pseudo_proj_True (Suc n) -`{w}) = prob {x. stake n x = stake n w} * prob_component p w n"
        using bernoulli_stream_element_prob_rec' bernoulli bernoulli_stream_space p_lt_1 p_gt_0 by simp
      also have "... = prob {x. stake n x = stake n w} * (1-p)" using ¬snth w n unfolding prob_component_def by simp
      finally show "prob (pseudo_proj_True (Suc n) -`{w}  space M) = prob {x. stake n x = stake n w} * (1-p)"  using bernoulli
        bernoulli_stream_space by simp
    qed
    thus ?thesis  by simp
  qed
  also have "... = (wpseudo_proj_True n ` g -` {g z}. prob ({x. stake n x = stake n w})) * p * f (pseudo_proj_True n z) +
    (wpseudo_proj_False n ` g -` {g z}. prob {x. stake n x = stake n w}) * (1 -p) * f (pseudo_proj_False n z)"
    by (simp add:sum_distrib_right)
  also have "... = prob (g -` {g z}) * p * f (pseudo_proj_True n z) +
    (wpseudo_proj_False n ` g -` {g z}. prob {x. stake n x = stake n w}) * (1 -p) * f (pseudo_proj_False n z)"
  proof -
    have projset: "w. wpseudo_proj_True n ` g -` {g z}  {x. stake n x = stake n w}  sets M"
    proof -
      fix w
      assume "w pseudo_proj_True n ` g -` {g z}"
      hence "y. w = pseudo_proj_True n y" by auto
      from this obtain y where "w = pseudo_proj_True n y" by auto
      hence "w = pseudo_proj_True n w" by (simp add: pseudo_proj_True_proj)
      hence "pseudo_proj_True n -`{w} = {x. stake n x = stake n w}"  using pseudo_proj_True_preimage_stake by simp
      moreover have "pseudo_proj_True n -`{w}  sets M"
        using w = pseudo_proj_True n w bernoulli bernoulli_stream_space pseudo_proj_True_singleton by auto
      ultimately show "{x. stake n x = stake n w}  sets M" by simp
    qed
    have "(wpseudo_proj_True n ` g -` {g z}. prob ({x. stake n x = stake n w})) =
      prob (wpseudo_proj_True n ` g -` {g z}. {x. stake n x = stake n w})"
    proof (rule finite_measure_finite_Union[symmetric])
      show "finite (pseudo_proj_True n ` g -` {g z})"
        by (meson finite_subset image_mono pseudo_proj_True_finite_image subset_UNIV)
      show "(λi. {x. stake n x = stake n i}) ` pseudo_proj_True n ` g -` {g z}  events" using projset by auto
      show "disjoint_family_on (λi. {x. stake n x = stake n i}) (pseudo_proj_True n ` g -` {g z})"
        unfolding disjoint_family_on_def
      proof (intro ballI impI)
        fix u v
        assume "u   pseudo_proj_True n ` g -` {g z}" and "v pseudo_proj_True n ` g -` {g z}" and "u  v" note uvprops = this
        show "{x. stake n x = stake n u}  {x. stake n x = stake n v} = {}"
        proof (rule ccontr)
          assume "{x. stake n x = stake n u}  {x. stake n x = stake n v}  {}"
          hence " uu. uu {x. stake n x = stake n u}  {x. stake n x = stake n v}" by auto
          from this obtain uu where "uu {x. stake n x = stake n u}  {x. stake n x = stake n v}" by auto
          hence "stake n uu = stake n u" and "stake n uu = stake n v" by auto
          moreover have "stake n u  stake n v" by (metis uvprops imageE pseudo_proj_True_proj pseudo_proj_True_stake_image)
          ultimately show False by simp
        qed
      qed
    qed
    also have "... = prob (wpseudo_proj_True n ` g -` {g z}. pseudo_proj_True n -`{w})"
    proof -
      have "w. wpseudo_proj_True n ` g -` {g z}  {x. stake n x = stake n w} =  pseudo_proj_True n -`{w}"
        using pseudo_proj_True_preimage_stake pseudo_proj_True_proj by force
      hence "(wpseudo_proj_True n ` g -` {g z}. {x. stake n x = stake n w}) =
        (wpseudo_proj_True n ` g -` {g z}. pseudo_proj_True n -`{w})" by auto
      thus ?thesis by simp
    qed
    also have "... = prob (pseudo_proj_True n -`(pseudo_proj_True n ` g -` {g z}))" by (metis vimage_eq_UN)
    also have "... = prob (g -` {g z})" using pseudo_proj_preimage[symmetric, of g n N z]
      pseudo_proj_preimage'[of g n] assms by simp
    finally have "(wpseudo_proj_True n ` g -` {g z}. prob ({x. stake n x = stake n w})) = prob (g -` {g z})" .
    thus ?thesis by simp
  qed
  also have "... = prob (g -` {g z}) * p * f (pseudo_proj_True n z) +
    prob (g -`{g z}) * (1 -p) * f (pseudo_proj_False n z)"
  proof -
    have projset: "w. wpseudo_proj_False n ` g -` {g z}  {x. stake n x = stake n w}  sets M"
    proof -
      fix w
      assume "w pseudo_proj_False n ` g -` {g z}"
      hence "y. w = pseudo_proj_False n y" by auto
      from this obtain y where "w = pseudo_proj_False n y" by auto
      hence "w = pseudo_proj_False n w" using pseudo_proj_False_def pseudo_proj_False_stake by auto
      hence "pseudo_proj_False n -`{w} = {x. stake n x = stake n w}"  using pseudo_proj_False_preimage_stake by simp
      moreover have "pseudo_proj_False n -`{w}  sets M"
        using w = pseudo_proj_False n w bernoulli bernoulli_stream_space pseudo_proj_False_singleton by auto
      ultimately show "{x. stake n x = stake n w}  sets M" by simp
    qed
    have "(wpseudo_proj_False n ` g -` {g z}. prob ({x. stake n x = stake n w})) =
      prob (wpseudo_proj_False n ` g -` {g z}. {x. stake n x = stake n w})"
    proof (rule finite_measure_finite_Union[symmetric])
      show "finite (pseudo_proj_False n ` g -` {g z})"
        by (meson finite_subset image_mono pseudo_proj_False_finite_image subset_UNIV)
      show "(λi. {x. stake n x = stake n i}) ` pseudo_proj_False n ` g -` {g z}  events" using projset by auto
      show "disjoint_family_on (λi. {x. stake n x = stake n i}) (pseudo_proj_False n ` g -` {g z})"
        unfolding disjoint_family_on_def
      proof (intro ballI impI)
        fix u v
        assume "u   pseudo_proj_False n ` g -` {g z}" and "v pseudo_proj_False n ` g -` {g z}" and "u  v" note uvprops = this
        show "{x. stake n x = stake n u}  {x. stake n x = stake n v} = {}"
        proof (rule ccontr)
          assume "{x. stake n x = stake n u}  {x. stake n x = stake n v}  {}"
          hence " uu. uu {x. stake n x = stake n u}  {x. stake n x = stake n v}" by auto
          from this obtain uu where "uu {x. stake n x = stake n u}  {x. stake n x = stake n v}" by auto
          hence "stake n uu = stake n u" and "stake n uu = stake n v" by auto
          moreover have "stake n u  stake n v"
            using pseudo_proj_False_def pseudo_proj_False_stake uvprops by auto
          ultimately show False by simp
        qed
      qed
    qed
    also have "... = prob (wpseudo_proj_False n ` g -` {g z}. pseudo_proj_False n -`{w})"
    proof -
      have "w. wpseudo_proj_False n ` g -` {g z}  {x. stake n x = stake n w} =  pseudo_proj_False n -`{w}"
        using pseudo_proj_False_preimage_stake pseudo_proj_False_def pseudo_proj_False_stake by force
      hence "(wpseudo_proj_False n ` g -` {g z}. {x. stake n x = stake n w}) =
        (wpseudo_proj_False n ` g -` {g z}. pseudo_proj_False n -`{w})" by auto
      thus ?thesis by simp
    qed
    also have "... = prob (pseudo_proj_False n -`(pseudo_proj_False n ` g -` {g z}))" by (metis vimage_eq_UN)
    also have "... = prob (g -` {g z})" using pseudo_proj_False_preimage[symmetric, of g n N z]
      pseudo_proj_False_preimage'[of g n] assms by simp
    finally have "(wpseudo_proj_False n ` g -` {g z}. prob ({x. stake n x = stake n w})) = prob (g -` {g z})" .
    thus ?thesis by simp
  qed
  also have "... = prob (g -` {g z}) * (p * f (pseudo_proj_True n z) +
     (1 -p) * f (pseudo_proj_False n z))"
    using distrib_left[symmetric, of "prob (g -` {g z})" "p * f (pseudo_proj_True n z)" "(1 - p) * f (pseudo_proj_False n z)"]
    by simp
  finally show "expectation (λx. f x * indicator (g -` {g z}) x) =
    prob (g -` {g z}) * (p * f (pseudo_proj_True n z) +
     (1 -p) * f (pseudo_proj_False n z))" unfolding expind_def .
qed


lemma (in infinite_cts_filtration) borel_Suc_expectation_pseudo_proj:
  fixes f::"bool stream real"
  assumes "f borel_measurable (F (Suc n))"
  shows "expectation (λx. f x * indicator (pseudo_proj_True n -` {pseudo_proj_True n z}) x) =
    prob (pseudo_proj_True n -` {pseudo_proj_True n z}) *
    (p * (f (pseudo_proj_True n z)) + (1-p) * (f (pseudo_proj_False n z)))"
proof (rule borel_Suc_expectation)
  show "f  borel_measurable (F (Suc n))" using assms by simp
  show "pseudo_proj_True n  F n M M"
    by (simp add: nat_filtration_pseudo_proj_True_measurable natural_filtration)
  show "pseudo_proj_True n -` {pseudo_proj_True n z}  sets (F n)"
    by (simp add: nat_filtration_singleton natural_filtration pseudo_proj_True_proj)
  show "y z. (pseudo_proj_True n y = pseudo_proj_True n z  snth y n = snth z n)  f y = f z"
  proof (intro allI impI conjI)
    fix y z
    assume "pseudo_proj_True n y = pseudo_proj_True n z  y !! n = z !! n"
    hence "pseudo_proj_True n y = pseudo_proj_True n z" and "snth y n = snth z n" by auto
    hence "pseudo_proj_True (Suc n) y = pseudo_proj_True (Suc n) z" unfolding pseudo_proj_True_def
      by (metis (full_types) ‹pseudo_proj_True n y = pseudo_proj_True n z pseudo_proj_True_same_img stake_Suc)
    thus "f y = f z" using nat_filtration_info assms natural_filtration by (metis comp_apply)
  qed
  show "set_discriminating n (pseudo_proj_True n) M" unfolding set_discriminating_def using pseudo_proj_True_proj by simp
qed



lemma (in infinite_cts_filtration) f_borel_Suc_expl_cond_expect:
  assumes "f borel_measurable (F (Suc n))"
  and "g measurable (F n) N"
  and "set_discriminating n g N"
  and "g -` {g w}  sets (F n)"
  and "y z. (g y = g z  snth y n = snth z n)  f y = f z"
and "0 < p"
and "p < 1"
  shows "expl_cond_expect M g f w = p * f (pseudo_proj_True n w) + (1 - p) * f (pseudo_proj_False n w)"
proof -
  have nz:"prob (g -`{g w})  0"
  proof -
    have "pseudo_proj_True n -`{pseudo_proj_True n w}   g -` {g w}"
    proof -
      have "f n m s. f  F n M m  ¬ set_discriminating n f m  pseudo_proj_True n -` f -` {f s::'a} = f -` {f s}"
        by (meson pseudo_proj_preimage')
      then show ?thesis using assms by blast
    qed
    moreover have "prob (pseudo_proj_True n -`{pseudo_proj_True n w}) > 0" using bernoulli_stream_pref_prob_pos
      pseudo_proj_True_preimage_stake bernoulli bernoulli_stream_space emeasure_eq_measure pseudo_proj_True_proj assms by auto
    moreover have "pseudo_proj_True n -`{pseudo_proj_True n w}  sets M"
      using bernoulli bernoulli_stream_space pseudo_proj_True_proj pseudo_proj_True_singleton by auto
    moreover have "g -`{g w}  events" using assms natural_filtration nat_filtration_subalgebra
      unfolding subalgebra_def by blast
    ultimately show ?thesis using  measure_increasing  increasingD
    proof -
      have "g -` {g w}  events  pseudo_proj_True n -` {pseudo_proj_True n w}  events  prob (pseudo_proj_True n -` {pseudo_proj_True n w})  prob (g -` {g w})"
        using ‹pseudo_proj_True n -` {pseudo_proj_True n w}  g -` {g w} increasingD measure_increasing by blast
      then show ?thesis
        using 0 < prob (pseudo_proj_True n -` {pseudo_proj_True n w}) g -` {g w}  events› ‹pseudo_proj_True n -` {pseudo_proj_True n w}  events› by linarith
    qed
  qed
  hence "expl_cond_expect M g f w =
    expectation (λx. f x * indicator (g -` {g w}  space M) x) /
      prob (g -` {g w}  space M)" unfolding expl_cond_expect_def img_dce_def
    by simp
  also have "... = expectation (λx. f x * indicator (g -` {g w}) x) / prob (g -` {g w})"
    using bernoulli by (simp add:bernoulli_stream_space)
  also have "... = prob (g -` {g w}) * (p * f (pseudo_proj_True n w) +
     (1 -p) * f (pseudo_proj_False n w)) / prob (g -` {g w})"
  proof -
    have "expectation (λx. f x * indicator (g -` {g w}) x) = prob (g -` {g w}) * (p * f (pseudo_proj_True n w) +
     (1 -p) * f (pseudo_proj_False n w))"
    proof (rule borel_Suc_expectation)
      show "f  borel_measurable (F (Suc n))" using assms by simp
      show "g  F n M N" using assms by simp
      show "set_discriminating n g N" using assms by simp
      show "g -` {g w}  sets (F n)" using assms by simp
      show "y z. g y = g z  y !! n = z !! n  f y = f z" using assms(5) by blast
    qed
    thus ?thesis by simp
  qed
  also have "... = p * f (pseudo_proj_True n w) + (1 -p) * f (pseudo_proj_False n w)" using nz by simp
  finally show ?thesis .
qed


lemma (in infinite_cts_filtration) f_borel_Suc_real_cond_exp:
  assumes "f borel_measurable (F (Suc n))"
  and "g measurable (F n) N"
  and "set_discriminating n g N"
  and "w. g -` {g w}  sets (F n)"
  and "rrange g  space N. Asets N. range g  A = {r}"
  and "y z. (g y = g z  snth y n = snth z n)  f y = f z"
  and "0 < p"
and "p < 1"
  shows "AE w in M. real_cond_exp M (fct_gen_subalgebra M N g) f w = p * f (pseudo_proj_True n w) + (1 - p) * f (pseudo_proj_False n w)"
proof -
  have "AE w in M. real_cond_exp M (fct_gen_subalgebra M N g) f w = expl_cond_expect M g f w"
  proof (rule charact_cond_exp')
    show "disc_fct g"
    proof -
      have "g = g  (pseudo_proj_True n)" using nat_filtration_not_borel_info[of g n] assms natural_filtration by simp
      have "disc_fct (pseudo_proj_True n)"  unfolding disc_fct_def using pseudo_proj_True_finite_image
        by (simp add: countable_finite)
      hence "disc_fct (g  (pseudo_proj_True n))" unfolding disc_fct_def
        by (metis countable_image image_comp)
      thus ?thesis using g = g  (pseudo_proj_True n) by simp
    qed
    show "integrable M f" using assms nat_filtration_borel_measurable_integrable natural_filtration by simp
    show "random_variable N g" using assms filtration_measurable natural_filtration nat_filtration_subalgebra
      using nat_discrete_filtration by blast
    show "rrange g  space N. Asets N. range g  A = {r}" using assms by simp
  qed
  moreover have "w. expl_cond_expect M g f w = p * f (pseudo_proj_True n w) + (1 - p) * f (pseudo_proj_False n w)"
    using assms f_borel_Suc_expl_cond_expect by blast
  ultimately show ?thesis by simp
qed

lemma (in infinite_cts_filtration) f_borel_Suc_real_cond_exp_proj:
  assumes "f borel_measurable (F (Suc n))"
and "0 < p"
and "p < 1"
shows "AE w in M. real_cond_exp M (fct_gen_subalgebra M M (pseudo_proj_True n)) f w =
  p * f (pseudo_proj_True n w) + (1 - p) * f (pseudo_proj_False n w)"
proof (rule f_borel_Suc_real_cond_exp)
  show "f  borel_measurable (F (Suc n))" using assms by simp
  show "pseudo_proj_True n  F n M M"
    by (simp add: nat_filtration_pseudo_proj_True_measurable natural_filtration)
  show "w. pseudo_proj_True n -` {pseudo_proj_True n w}  sets (F n)"
  proof
    fix w
    show "pseudo_proj_True n -` {pseudo_proj_True n w}  sets (F n) "
      by (simp add: nat_filtration_singleton natural_filtration pseudo_proj_True_proj)
  qed
  show "rrange (pseudo_proj_True n)  space M. Aevents. range (pseudo_proj_True n)  A = {r}"
  proof (intro ballI)
    fix r
    assume "r  range (pseudo_proj_True n)  space M"
    hence "r range (pseudo_proj_True n)" and "r space M" by auto
    hence "pseudo_proj_True n r = r" using pseudo_proj_True_proj by auto
    hence "(pseudo_proj_True n) -`{r}  space M  sets M" using pseudo_proj_True_singleton bernoulli by simp
    moreover have "range (pseudo_proj_True n)  ((pseudo_proj_True n) -`{r}  space M) = {r}"
    proof
      have "r range (pseudo_proj_True n)  (pseudo_proj_True n -` {r}  space M)"
        using ‹pseudo_proj_True n r = r r  range (pseudo_proj_True n) r  space M by blast
      thus "{r}  range (pseudo_proj_True n)  (pseudo_proj_True n -` {r}  space M)" by auto
      show "range (pseudo_proj_True n)  (pseudo_proj_True n -` {r}  space M)  {r}"
      proof
        fix x
        assume "x  range (pseudo_proj_True n)  (pseudo_proj_True n -` {r}  space M)"
        hence "x range (pseudo_proj_True n)" and "x (pseudo_proj_True n -` {r})" by auto
        have "x = pseudo_proj_True n x" using x range (pseudo_proj_True n) pseudo_proj_True_proj by auto
        also have "... = r" using x (pseudo_proj_True n -` {r}) by simp
        finally have "x = r" .
        thus "x {r}" by simp
      qed
    qed
    ultimately show "Aevents. range (pseudo_proj_True n)  A = {r}" by auto
  qed
  show "y z. pseudo_proj_True n y = pseudo_proj_True n z  y !! n = z !! n  f y = f z"
  proof (intro allI impI conjI)
    fix y z
    assume "pseudo_proj_True n y = pseudo_proj_True n z  y !! n = z !! n"
    hence "pseudo_proj_True n y = pseudo_proj_True n z" and "snth y n = snth z n" by auto
    hence "pseudo_proj_True (Suc n) y = pseudo_proj_True (Suc n) z" unfolding pseudo_proj_True_def
      by (metis (full_types) ‹pseudo_proj_True n y = pseudo_proj_True n z pseudo_proj_True_same_img stake_Suc)
    thus "f y = f z" using nat_filtration_info assms natural_filtration by (metis comp_apply)
  qed
  show "set_discriminating n (pseudo_proj_True n) M" unfolding set_discriminating_def using pseudo_proj_True_proj by simp
  show "0 < p" and "p < 1" using assms by auto
qed


subsection  ‹Images of stochastic processes by prefixes of streams›

text ‹We define a function that, given a stream of coin tosses and a stochastic process, returns a stream of the values
of the stochastic process up to a given time. This function will be used to characterize the smallest filtration that,
at any time n, makes each random variable of a given stochastic process measurable up to time n.›

subsubsection ‹Definitions›



primrec smap_stoch_proc where
  "smap_stoch_proc 0 f k w = []"
| "smap_stoch_proc (Suc n) f k w = (f k w) # (smap_stoch_proc n f (Suc k) w)"


lemma smap_stoch_proc_length:
  shows "length (smap_stoch_proc n f k w) = n"
  by (induction n arbitrary:k) auto


lemma smap_stoch_proc_nth:
  shows "Suc p  Suc n  nth (smap_stoch_proc (Suc n) f k w) p = f (k+p) w"
proof (induction n arbitrary:p k)
  case 0
  hence "p = 0" by simp
  hence "(smap_stoch_proc (Suc 0) f k w) ! p = ((f k w) # (smap_stoch_proc 0 f (Suc k) w))!0" by simp
  also have "... = f (k+p) w" using p=0 by simp
  finally show ?case .
next
  case (Suc n)
  show ?case
  proof (cases "m. p = Suc m")
    case True
    from this obtain m where "p = Suc m" by auto
    hence "smap_stoch_proc (Suc (Suc n)) f k w ! p = (smap_stoch_proc (Suc n) f (Suc k) w) ! m" by simp
    also have "... = f ((Suc k) + m) w" using Suc(1)[of m] Suc.prems p = Suc m by blast
    also have "... = f (k + (Suc m)) w" by simp
    finally show "smap_stoch_proc (Suc (Suc n)) f k w ! p = f (k + p) w" using p = Suc m by simp
  next
    case False
    hence "p = 0" using less_Suc_eq_0_disj by blast
    thus "smap_stoch_proc (Suc (Suc n)) f k w ! p =  f (k+p) w" by simp
  qed
qed


definition proj_stoch_proc where
"proj_stoch_proc f n = (λw. shift (smap_stoch_proc n f 0 w) (sconst (f n w)))"


lemma proj_stoch_proc_component:
  shows "k < n  (snth (proj_stoch_proc f n w) k) = f k w"
    and "n  k  (snth (proj_stoch_proc f n w) k) = f n w"
proof -
  show "k < n  proj_stoch_proc f n w !! k = f k w"
  proof -
    assume "k < n"
    hence "m. n = Suc m" using less_imp_Suc_add by blast
    from this obtain m where "n = Suc m" by auto
    have "proj_stoch_proc f n w !! k = (smap_stoch_proc n f 0 w) ! k" unfolding proj_stoch_proc_def
      using k<n by (simp add: smap_stoch_proc_length)
    also have "... = f k w" using n = Suc m k < n smap_stoch_proc_nth
      by (metis Suc_leI add.left_neutral)
    finally show ?thesis .
  qed
  show "n  k  (snth (proj_stoch_proc f n w) k) = f n w"
  proof -
    assume "n  k"
    hence "proj_stoch_proc f n w !! k = (sconst (f n w)) !! (k - n)"
      by (simp add: proj_stoch_proc_def smap_stoch_proc_length)
    also have "... = f n w" by simp
    finally show ?thesis .
  qed
qed

lemma proj_stoch_proc_component':
  assumes "k  n"
  shows "f k x = snth (proj_stoch_proc f n x) k"
  proof (cases "k < n")
    case True
    thus ?thesis using proj_stoch_proc_component[of k n f x] assms by simp
  next
    case False
    hence "k = n" using assms by simp
    thus ?thesis using proj_stoch_proc_component[of k n f x] assms by simp
  qed

lemma proj_stoch_proc_eq_snth:
  assumes "proj_stoch_proc f n x = proj_stoch_proc f n y"
and "k  n"
shows "f k x = f k y"
proof -
  have "f k x = snth (proj_stoch_proc f n x) k"  using assms proj_stoch_proc_component'[of k n f] by simp
  also have "... = snth (proj_stoch_proc f n y) k" using assms by simp
  also have "... = f k y" using assms proj_stoch_proc_component'[of k n f] by simp
  finally show ?thesis .
qed

lemma proj_stoch_measurable_if_adapted:
  assumes "filtration M F"
  and "adapt_stoch_proc F f N"
  shows "proj_stoch_proc f n  measurable M (stream_space N)"
proof (rule measurable_stream_space2)
  fix m
  show "(λx. proj_stoch_proc f n x !! m)  M M N"
  proof (cases "m < n")
    case True
    hence "x. proj_stoch_proc f n x !! m = f m x" by (simp add: proj_stoch_proc_component)
    hence "(λx. proj_stoch_proc f n x !! m) = f m" by simp
    thus ?thesis using assms unfolding adapt_stoch_proc_def filtration_def
      by (metis measurable_from_subalg)
  next
    case False
    hence "x. proj_stoch_proc f n x !! m = f n x" by (simp add: proj_stoch_proc_component)
    hence "(λx. proj_stoch_proc f n x !! m) = f n" by simp
    thus ?thesis using assms unfolding adapt_stoch_proc_def filtration_def
      by (metis measurable_from_subalg)
  qed
qed

lemma proj_stoch_adapted_if_adapted:
  assumes "filtration M F"
  and "adapt_stoch_proc F f N"
  shows "proj_stoch_proc f n  measurable (F n) (stream_space N)"
proof (rule measurable_stream_space2)
  fix m
  show "(λx. proj_stoch_proc f n x !! m)  measurable (F n) N"
  proof (cases "m < n")
    case True
    hence "x. proj_stoch_proc f n x !! m = f m x" by (simp add: proj_stoch_proc_component)
    hence "(λx. proj_stoch_proc f n x !! m) = f m" by simp
    thus ?thesis using assms unfolding adapt_stoch_proc_def filtration_def
      by (metis True measurable_from_subalg not_less order.asym)
  next
    case False
    hence "x. proj_stoch_proc f n x !! m = f n x" by (simp add: proj_stoch_proc_component)
    hence "(λx. proj_stoch_proc f n x !! m) = f n" by simp
    thus ?thesis using assms unfolding adapt_stoch_proc_def by metis
  qed
qed

lemma proj_stoch_adapted_if_adapted':
  assumes "filtration M F"
  and "adapt_stoch_proc F f N"
shows "adapt_stoch_proc F (proj_stoch_proc f) (stream_space N)" unfolding adapt_stoch_proc_def
proof
  fix n
  show "proj_stoch_proc f n  F n M stream_space N" using assms by (simp add: proj_stoch_adapted_if_adapted)
qed


lemma (in infinite_cts_filtration) proj_stoch_proj_invariant:
fixes X::"nat  bool stream  'b::{t0_space}"
  assumes "borel_adapt_stoch_proc F X"
shows "proj_stoch_proc X n w = proj_stoch_proc X n (pseudo_proj_True n w)"
proof -
  have "m. snth (proj_stoch_proc X n w) m = snth (proj_stoch_proc X n (pseudo_proj_True n w)) m"
  proof -
    fix m
    show "snth (proj_stoch_proc X n w) m = snth (proj_stoch_proc X n (pseudo_proj_True n w)) m"
    proof (cases "m < n")
      case True
      hence "snth (proj_stoch_proc X n w) m = X m w" by (simp add: proj_stoch_proc_component)
      also have "... = X m (pseudo_proj_True n w)"
      proof (rule borel_adapt_nat_filtration_info[symmetric], (simp add:assms))
        show "m  n" using True by linarith
      qed
      also have "... = snth (proj_stoch_proc X n (pseudo_proj_True n w)) m" using True
        by (simp add: proj_stoch_proc_component)
      finally show ?thesis .
    next
      case False
      hence "snth (proj_stoch_proc X n w) m = X n w" by (simp add: proj_stoch_proc_component)
      also have "... = X n (pseudo_proj_True n w)"
        by (rule borel_adapt_nat_filtration_info[symmetric]) (auto simp add:assms)
      also have "... = snth (proj_stoch_proc X n (pseudo_proj_True n w)) m" using False
        by (simp add: proj_stoch_proc_component)
      finally show ?thesis .
    qed
  qed
  thus "proj_stoch_proc X n w = proj_stoch_proc X n (pseudo_proj_True n w)"
    using diff_streams_only_if by auto
qed

lemma (in infinite_cts_filtration) proj_stoch_set_finite_range:
  fixes X::"nat  bool stream  'b::{t0_space}"
  assumes "borel_adapt_stoch_proc F X"
  shows "finite (range (proj_stoch_proc X n))"
proof -
  have "finite (range (pseudo_proj_True n))" using pseudo_proj_True_finite_image by simp
  moreover have "proj_stoch_proc X n = (proj_stoch_proc X n)  (pseudo_proj_True n)"
  proof
    fix x
    show "proj_stoch_proc X n x = (proj_stoch_proc X n  pseudo_proj_True n) x"
      using assms proj_stoch_proj_invariant by (metis comp_apply)
  qed
  ultimately show ?thesis
    by (metis finite_imageI fun.set_map)
qed

lemma (in infinite_cts_filtration) proj_stoch_set_discriminating:
  fixes X::"nat  bool stream  'b::{t0_space}"
  assumes "borel_adapt_stoch_proc F X"
  shows "set_discriminating n (proj_stoch_proc X n) N"
proof -
  have "w. proj_stoch_proc X n w = proj_stoch_proc X n (pseudo_proj_True n w)"
    using assms proj_stoch_proj_invariant  by auto
  thus ?thesis unfolding set_discriminating_def by simp
qed

lemma (in infinite_cts_filtration) proj_stoch_preimage:
  assumes "borel_adapt_stoch_proc F X"
  shows "(proj_stoch_proc X n) -` {proj_stoch_proc X n w} = (i {m. m  n}. (X i) -` {X i w})"
proof
  define psX where "psX = proj_stoch_proc X n"
  show "proj_stoch_proc X n -` {proj_stoch_proc X n w}  (i{m. m  n}. X i -` {X i w})"
  proof
    fix x
    assume "x  proj_stoch_proc X n -` {proj_stoch_proc X n w}"
    hence "psX x = psX w" unfolding psX_def using assms by simp
    hence "i. i {m. m  n}  x   (X i) -`{X i w}"
    proof -
      fix i
      assume "i {m. mn}"
      hence "i  n" by auto
      have "X i x = snth (psX x) i" unfolding psX_def
        by (metis Suc_le_eq Suc_le_mono i  n le_Suc_eq nat.simps(1) proj_stoch_proc_component(1)
            proj_stoch_proc_component(2))
      also have "... = snth (psX w) i" using psX x = psX w by simp
      also have "... = X i w" unfolding psX_def
        by (metis Suc_le_eq Suc_le_mono i  n le_Suc_eq nat.simps(1) proj_stoch_proc_component(1)
            proj_stoch_proc_component(2))
      finally have "X i x = X i w" .
      thus "x   (X i) -`{X i w}" by simp
    qed
    thus "x  (i{m. m  n}. (X i) -` {X i w})" by auto
  qed
  show "(i{m. m  n}. (X i) -` {X i w})  (proj_stoch_proc X n) -` {proj_stoch_proc X n w}"
  proof
    fix x
    assume "x (i{m. m  n}. (X i) -` {X i w})"
    hence "i. i {m. m  n}  x   (X i) -`{X i w}" by simp
    hence "i. i {m. m  n}  X i x = X i w" by simp
    hence "i. i  n  X i x = X i w" by auto
    hence "psX x = psX w" unfolding psX_def
      by (metis (mono_tags, hide_lams) diff_streams_only_if linear not_le order_refl
          proj_stoch_proc_component(1) proj_stoch_proc_component(2))
    thus "x  (proj_stoch_proc X n) -` {proj_stoch_proc X n w}" unfolding psX_def by auto
  qed
qed


lemma (in infinite_cts_filtration) proj_stoch_singleton_set:
  fixes X::"nat  bool stream  ('b::t2_space)"
  assumes "borel_adapt_stoch_proc F X"
  shows "(proj_stoch_proc X n) -` {proj_stoch_proc X n w}  sets (F n)"
proof -
  have "i. i  n  (X i)  measurable (F n) borel"
    by (meson adapt_stoch_proc_def assms increasing_measurable_info)
  have "(i {m. m  n}. (X i) -` {X i w})  sets (F n)"
  proof ((rule sigma_algebra.countable_INT''), auto)
    show "sigma_algebra (space (F n)) (sets (F n))"
      using measure_space measure_space_def by auto
    show "UNIV  sets (F n)"
      using ‹sigma_algebra (space (F n)) (sets (F n)) nat_filtration_space natural_filtration
        sigma_algebra.sigma_sets_eq sigma_sets_top by fastforce
    have "i. i  n  (X i) -` {X i w}  sets (nat_filtration n)"
    proof (rule nat_filtration_borel_measurable_singleton)
      fix i
      assume "i  n"
      show "X i  borel_measurable (nat_filtration n)" using assms natural_filtration unfolding adapt_stoch_proc_def
        using i  n increasing_measurable_info by blast
    qed
    thus "i. i  n  (X i) -` {X i w}  sets (F n)" using natural_filtration by simp
  qed
  thus ?thesis using assms  by (simp add: proj_stoch_preimage)
qed


lemma (in infinite_cts_filtration) finite_range_stream_space:
  fixes f::"'a  'b::t1_space"
  assumes "finite (range f)"
  shows "(λw. snth w i) -` (open_exclude_set (f x) (range f))  sets (stream_space borel)"
proof -
  define opex where "opex = open_exclude_set (f x) (range f)"
  have "open opex" and "opex  (range f) = {f x}" using assms unfolding opex_def by
    (auto simp add:open_exclude_finite)
  hence "opex sets borel" by simp
  hence vim: "(λw. snth w i) -` opex  sets (vimage_algebra (streams (space borel)) (λw. snth w i) borel)"
    by (metis in_vimage_algebra inf_top.right_neutral space_borel streams_UNIV)
  have "(λw. snth w i) -` opex  sets (i. vimage_algebra (streams (space borel)) (λw. snth w i) borel)"
  proof (rule in_sets_SUP, simp)
    show "i. i  UNIV  space (vimage_algebra (streams (space borel)) (λw. w !! i) borel) =
      UNIV" by simp
    show "(λw. w !! i) -` opex  sets (vimage_algebra (streams (space borel)) (λw. w !! i) borel)"
      using vim by simp
  qed
  thus ?thesis using sets_stream_space_eq unfolding opex_def by blast
qed

lemma (in infinite_cts_filtration) proj_stoch_range_singleton:
  fixes X::"nat  bool stream  ('b::t2_space)"
  assumes "borel_adapt_stoch_proc F X"
  and "r range (proj_stoch_proc X n)"
shows "Asets (stream_space borel). range (proj_stoch_proc X n)  A = {r}"
proof -
  have "x. r = proj_stoch_proc X n x" using assms by auto
  from this obtain x where "r = proj_stoch_proc X n x" by auto
  have "i. i  n  (X i)  measurable (F n) borel"
    by (meson adapt_stoch_proc_def assms increasing_measurable_info)
  hence fin: "i. i  n  finite (range (X i))"
    by (metis bernoulli bernoulli_stream_space nat_filtration_vimage_finite natural_filtration streams_UNIV)
  show ?thesis
  proof
    define cand where "cand = (i  {m. m n}. (λw. snth w i) -` (open_exclude_set (X i x) (range (X i))))"
    show "cand  sets (stream_space borel)" unfolding cand_def
    proof ((rule sigma_algebra.countable_INT''), auto)
      show "UNIV  sets (stream_space borel)" by (metis space_borel streams_UNIV streams_stream_space)
      show "sigma_algebra (space (stream_space borel)) (sets (stream_space borel))"
        by (simp add: sets.sigma_algebra_axioms)
      show "i. i  n  (λw. w !! i) -` open_exclude_set (X i x) (range (X i))  sets (stream_space borel)"
      proof -
        fix i
        assume "i  n"
        thus "(λw. w !! i) -` open_exclude_set (X i x) (range (X i))  sets (stream_space borel)"
          using fin by (simp add:finite_range_stream_space)
      qed
    qed
    have "range (proj_stoch_proc X n)  cand = {proj_stoch_proc X n x}"
    proof
      have "proj_stoch_proc X n x  range (proj_stoch_proc X n)  cand"
      proof
        show "proj_stoch_proc X n x  range (proj_stoch_proc X n)" by simp
        show "proj_stoch_proc X n x  cand" unfolding cand_def
        proof
          fix i
          assume "i {m. m n}"
          hence "i  n" by simp
          hence "snth (proj_stoch_proc X n x) i = X i x"
            by (metis le_antisym not_less proj_stoch_proc_component)
          also have "...  open_exclude_set (X i x) (range (X i))" using assms open_exclude_finite(2)
            by (metis IntE i  n fin insert_iff rangeI)
          finally have "snth (proj_stoch_proc X n x) i  open_exclude_set (X i x) (range (X i))" .
          thus "proj_stoch_proc X n x  (λw. w !! i) -` open_exclude_set (X i x) (range (X i))" by simp
        qed
      qed
      thus "{proj_stoch_proc X n x}  range (proj_stoch_proc X n)  cand" by simp
      show "range (proj_stoch_proc X n)  cand  {proj_stoch_proc X n x}"
      proof
        fix z
        assume "z range (proj_stoch_proc X n)  cand"
        hence "y. z = proj_stoch_proc X n y" by auto
        from this obtain y where "z = proj_stoch_proc X n y" by auto
        hence "proj_stoch_proc X n y  cand" using z range (proj_stoch_proc X n)  cand by simp
        have "i. in  X i y = X i x"
        proof (intro allI impI)
          fix i
          assume "i  n"
          hence "X i y = snth (proj_stoch_proc X n y) i"
            by (metis le_antisym not_less proj_stoch_proc_component)
          also have "...  open_exclude_set (X i x) (range (X i))"
            using ‹proj_stoch_proc X n y  cand i  n unfolding cand_def by simp
          finally have "X i y  open_exclude_set (X i x) (range (X i))" .
          thus "X i y = X i x" using assms using assms open_exclude_finite(2)
            by (metis Int_iff i  n empty_iff fin insert_iff rangeI)
        qed
        hence "i. snth (proj_stoch_proc X n y) i = snth (proj_stoch_proc X n x) i"
          using proj_stoch_proc_component by (metis nat_le_linear not_less)
        hence "proj_stoch_proc X n y = proj_stoch_proc X n x"
          using diff_streams_only_if by auto
        thus "z {proj_stoch_proc X n x}" using z = proj_stoch_proc X n y by auto
      qed
    qed
    thus "range (proj_stoch_proc X n)  cand = {r}" using r = proj_stoch_proc X n x by simp
  qed
qed

definition (in infinite_cts_filtration) stream_space_single where
"stream_space_single X r = (if (U. U sets (stream_space borel)  U (range X) = {r})
  then SOME U. U sets (stream_space borel)  U  (range X) = {r} else {})"

lemma (in infinite_cts_filtration) stream_space_singleI:
  assumes "U. U sets (stream_space borel)  U (range X) = {r}"
  shows "stream_space_single X r  sets (stream_space borel)  stream_space_single X r  (range X) = {r}"
proof -
  let ?V = "SOME U. U sets (stream_space borel)  U (range X) = {r}"
  have vprop: "?V sets (stream_space borel)  ?V  (range X) = {r}" using someI_ex[of "λU. U sets (stream_space borel)  U (range X) = {r}"]
    assms by blast
  show ?thesis by (simp add:stream_space_single_def vprop assms)
qed

lemma (in infinite_cts_filtration)
fixes X::"nat  bool stream  ('b::t2_space)"
  assumes "borel_adapt_stoch_proc F X"
  and "r range (proj_stoch_proc X n)"
shows stream_space_single_set: "stream_space_single (proj_stoch_proc X n) r  sets (stream_space borel)"
and stream_space_single_preimage: "stream_space_single (proj_stoch_proc X n) r  range (proj_stoch_proc X n) = {r}"
proof -
  have "Asets (stream_space borel). range (proj_stoch_proc X n)  A = {r}"
    by (simp add: assms proj_stoch_range_singleton)
  hence "U. U  sets (stream_space borel)  U  range (proj_stoch_proc X n) = {r}" by auto
  hence a: "stream_space_single (proj_stoch_proc X n) r  sets (stream_space borel) 
    stream_space_single (proj_stoch_proc X n) r  (range (proj_stoch_proc X n)) = {r}"
    using stream_space_singleI[of "proj_stoch_proc X n"] by simp
  thus "stream_space_single (proj_stoch_proc X n) r  sets (stream_space borel)" by simp
  show "stream_space_single (proj_stoch_proc X n) r  range (proj_stoch_proc X n) = {r}" using a by simp
qed

subsubsection ‹Induced filtration, relationship with filtration generated by underlying stochastic process›

definition comp_proj_i where
"comp_proj_i X n i y = {z range (proj_stoch_proc X n). snth z i = y}"

lemma (in infinite_cts_filtration) comp_proj_i_finite:
  fixes X::"nat  bool stream  'b::{t0_space}"
  assumes "borel_adapt_stoch_proc F X"
  shows "finite (comp_proj_i X n i y)"
proof -
  have "finite (range (proj_stoch_proc X n))"
    using proj_stoch_set_finite_range[of X] assms by simp
  thus ?thesis unfolding comp_proj_i_def by simp
qed

lemma stoch_proc_comp_proj_i_preimage:
  assumes "i  n"
  shows "(X i) -` {X i x} = (z comp_proj_i X n i (X i x). (proj_stoch_proc X n) -` {z})"
proof
  show "X i -` {X i x}  (zcomp_proj_i X n i (X i x). proj_stoch_proc X n -` {z})"
  proof
    fix w
    assume "w  X i -` {X i x}"
    hence "X i w = X i x" by simp
    hence "snth (proj_stoch_proc X n w) i = X i x" using assms
      by (metis le_neq_implies_less proj_stoch_proc_component(1) proj_stoch_proc_component(2))
    hence "(proj_stoch_proc X n w)  comp_proj_i X n i (X i x)" unfolding comp_proj_i_def by simp
    moreover have "w proj_stoch_proc X i -` {proj_stoch_proc X i w}" by simp
    ultimately show "w (zcomp_proj_i X n i (X i x). proj_stoch_proc X n -` {z})" by simp
  qed
  show "(zcomp_proj_i X n i (X i x). proj_stoch_proc X n -` {z})  X i -` {X i x}"
  proof -
    have "z comp_proj_i X n i (X i x). proj_stoch_proc X n -` {z}  X i -` {X i x}"
    proof
      fix z
      assume "z comp_proj_i X n i (X i x)"
      hence "z range (proj_stoch_proc X n)" and "snth z i = X i x" unfolding comp_proj_i_def by auto
      show "proj_stoch_proc X n -` {z}  X i -` {X i x}"
      proof
        fix w
        assume "wproj_stoch_proc X n -` {z}"
        have "X i w = snth (proj_stoch_proc X n w) i" using assms
          by (metis le_neq_implies_less proj_stoch_proc_component(1) proj_stoch_proc_component(2))
        also have "... = snth z i" using wproj_stoch_proc X n -` {z} by auto
        also have "... = X i x" using ‹snth z i = X i x by simp
        finally have "X i w = X i x" .
        thus "w X i -` {X i x}" by simp
      qed
    qed
    thus ?thesis by auto
  qed
qed



(* comp_proj to remove? *)
definition comp_proj where
  "comp_proj X n y = {z range (proj_stoch_proc X n). snth z n = y}"

lemma (in infinite_cts_filtration) comp_proj_finite:
  fixes X::"nat  bool stream  'b::{t0_space}"
  assumes "borel_adapt_stoch_proc F X"
  shows "finite (comp_proj X n y)"
proof -
  have "finite (range (proj_stoch_proc X n))"
    using proj_stoch_set_finite_range[of X] assms by simp
  thus ?thesis unfolding comp_proj_def by simp
qed


lemma stoch_proc_comp_proj_preimage:
  shows "(X n) -` {X n x} = (z comp_proj X n (X n x). (proj_stoch_proc X n) -` {z})"
proof
  show "X n -` {X n x}  (zcomp_proj X n (X n x). proj_stoch_proc X n -` {z})"
  proof
    fix w
    assume "w  X n -` {X n x}"
    hence "X n w = X n x" by simp
    hence "snth (proj_stoch_proc X n w) n = X n x" by (simp add: proj_stoch_proc_component(2))
    hence "(proj_stoch_proc X n w)  comp_proj X n (X n x)" unfolding comp_proj_def by simp
    moreover have "w proj_stoch_proc X n -` {proj_stoch_proc X n w}" by simp
    ultimately show "w (zcomp_proj X n (X n x). proj_stoch_proc X n -` {z})" by simp
  qed
  show "(zcomp_proj X n (X n x). proj_stoch_proc X n -` {z})  X n -` {X n x}"
  proof -
    have "z comp_proj X n (X n x). proj_stoch_proc X n -` {z}  X n -` {X n x}"
    proof
      fix z
      assume "z comp_proj X n (X n x)"
      hence "z range (proj_stoch_proc X n)" and "snth z n = X n x" unfolding comp_proj_def by auto
      show "proj_stoch_proc X n -` {z}  X n -` {X n x}"
      proof
        fix w
        assume "wproj_stoch_proc X n -` {z}"
        have "X n w = snth (proj_stoch_proc X n w) n" by (simp add: proj_stoch_proc_component(2))
        also have "... = snth z n" using wproj_stoch_proc X n -` {z} by auto
        also have "... = X n x" using ‹snth z n = X n x by simp
        finally have "X n w = X n x" .
        thus "w X n -` {X n x}" by simp
      qed
    qed
    thus ?thesis by auto
  qed
qed


lemma comp_proj_stoch_proc_preimage:
  shows "(proj_stoch_proc X n) -` {proj_stoch_proc X n x} = ( i {m. mn}. (X i) -`{X i x})"
proof
  show "proj_stoch_proc X n -` {proj_stoch_proc X n x}  (i{m. m  n}. X i -` {X i x})"
  proof
    fix z
    assume "z proj_stoch_proc X n -` {proj_stoch_proc X n x}"
    hence "proj_stoch_proc X n z = proj_stoch_proc X n x" by simp
    hence "in. X i z = X i x" using proj_stoch_proc_component by (metis less_le)
    hence "in. z X i -`{X i x}" by simp
    thus "z (i{m. m  n}. X i -` {X i x})" by simp
  qed
  show "(i{m. m  n}. X i -` {X i x})  proj_stoch_proc X n -` {proj_stoch_proc X n x}"
  proof
    fix z
    assume "z (i{m. m  n}. X i -` {X i x})"
    hence "i n. X i z = X i x" by auto
    hence "i. snth (proj_stoch_proc X n z) i = snth (proj_stoch_proc X n x) i"
      using proj_stoch_proc_component by (metis nat_le_linear not_less)
    hence "proj_stoch_proc X n z = proj_stoch_proc X n x" using diff_streams_only_if by auto
    thus "z proj_stoch_proc X n -` {proj_stoch_proc X n x}" by simp
  qed
qed



definition  stoch_proc_filt where
  "stoch_proc_filt M X N (n::nat) = gen_subalgebra M (sigma_sets (space M) ( i {m. m n}. {(X i -`A)  (space M) | A. A sets N }))"



lemma  stoch_proc_filt_space:
  shows "space (stoch_proc_filt M X N n) = space M" unfolding stoch_proc_filt_def by (simp add:gen_subalgebra_space)




lemma  stoch_proc_filt_sets:
assumes "i. i  n (X i)  measurable M N"
  shows "sets (stoch_proc_filt M X N n) = (sigma_sets (space M) ( i {m. m n}. {(X i -`A)  (space M) | A. A sets N }))"
  unfolding stoch_proc_filt_def
proof (rule gen_subalgebra_sigma_sets)
  show "sigma_algebra (space M) (sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets N}))" using assms
    by (simp add: adapt_sigma_sets)
  show "sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets N})  sets M"
  proof (rule sigma_algebra.sigma_sets_subset, rule Sigma_Algebra.sets.sigma_algebra_axioms, rule UN_subset_iff[THEN iffD2], intro ballI)
    fix i
    assume "i {m. mn}"
    thus "{X i -` A  space M |A. A  sets N}  sets M" using assms measurable_sets by blast
  qed
qed


lemma stoch_proc_filt_adapt:
  assumes "n. X n  measurable M N"
  shows "adapt_stoch_proc (stoch_proc_filt M X N) X N" unfolding adapt_stoch_proc_def
proof
  fix m
  show "X m  measurable (stoch_proc_filt M X N m) N" unfolding measurable_def
  proof ((intro CollectI), (intro conjI))
    have "space (stoch_proc_filt M X N m) = space M" by (simp add: stoch_proc_filt_space)
    thus "X m  space (stoch_proc_filt M X N m)  space N" using assms unfolding measurable_def by simp
    show "ysets N. X m -` y  space (stoch_proc_filt M X N m)  sets (stoch_proc_filt M X N m)"
    proof
      fix B
      assume "B sets N"
      have "X m -` B  space (stoch_proc_filt M X N m) = X m -`B  space M"
        using ‹space (stoch_proc_filt M X N m) = space M by simp
      also have "...  ( i {p. p m}. {(X i -`A)  (space M) | A. A sets N })" using B sets N by auto
      also have "...  sigma_sets (space M) ( i {p. p m}. {(X i -`A)  (space M) | A. A sets N })" by auto
      also have "... = sets (stoch_proc_filt M X N m)" using assms stoch_proc_filt_sets by blast
      finally show "X m -` B  space (stoch_proc_filt M X N m)  sets (stoch_proc_filt M X N m)" .
    qed
  qed
qed



lemma  stoch_proc_filt_disc_filtr:
  assumes "i. (X i)  measurable M N"
  shows "disc_filtr M (stoch_proc_filt M X N)" unfolding disc_filtr_def
proof (intro conjI allI impI)
{
  fix n
  show "subalgebra M (stoch_proc_filt M X N n)" unfolding subalgebra_def
  proof
    show "space (stoch_proc_filt M X N n) = space M" by (simp add:stoch_proc_filt_space)
    show "sets (stoch_proc_filt M X N n)  sets M"
    proof -
      have "sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets N})  sets M"
      proof (rule sigma_algebra.sigma_sets_subset, rule Sigma_Algebra.sets.sigma_algebra_axioms, rule UN_subset_iff[THEN iffD2], intro ballI)
        fix i
        assume "i {m. mn}"
        thus "{X i -` A  space M |A. A  sets N}  sets M" using assms measurable_sets by blast
      qed
      thus ?thesis using assms by (simp add:stoch_proc_filt_sets)
    qed
  qed
}
{
  fix n
  fix p
  assume "(n::nat)  p"
  show "subalgebra (stoch_proc_filt M X N p) (stoch_proc_filt M X N n)" unfolding subalgebra_def
  proof
    have "space (stoch_proc_filt M X N n) = space M" by (simp add: stoch_proc_filt_space)
    also have "... = space (stoch_proc_filt M X N p)" by (simp add: stoch_proc_filt_space)
    finally show "space (stoch_proc_filt M X N n) = space (stoch_proc_filt M X N p)" .
    show "sets (stoch_proc_filt M X N n)  sets (stoch_proc_filt M X N p)"
    proof -
      have "sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets N}) 
        sigma_sets (space M) (i{m. m  p}. {X i -` A  space M |A. A  sets N})"
      proof (rule sigma_sets_mono')
        show "(i{m. m  n}. {X i -` A  space M |A. A  sets N})  (i{m. m  p}. {X i -` A  space M |A. A  sets N})"
        proof (rule UN_subset_iff[THEN iffD2], intro ballI)
          fix i
          assume "i {m. mn}"
          show "{X i -` A  space M |A. A  sets N}  (i{m. m  p}. {X i -` A  space M |A. A  sets N})"
            using i  {m. m  n} n  p order_trans by auto
        qed
      qed
      thus ?thesis using assms by (simp add:stoch_proc_filt_sets)
    qed
  qed
}
qed


lemma gen_subalgebra_eq_space_sets:
  assumes "space M = space N"
  and "P = Q"
  and "P Pow (space M)"
  shows "sets (gen_subalgebra M P) = sets (gen_subalgebra N Q)" unfolding gen_subalgebra_def using assms by simp

lemma stoch_proc_filt_eq_sets:
  assumes "space M = space N"
  shows "sets (stoch_proc_filt M X P n) = sets (stoch_proc_filt N X P n)" unfolding stoch_proc_filt_def
proof (rule gen_subalgebra_eq_space_sets, (simp add: assms)+)
  show "sigma_sets (space N) (x{m. m  n}. {X x -` A  space N |A. A  sets P})  Pow (space N)"
  proof (rule sigma_algebra.sigma_sets_subset)
    show "sigma_algebra (space N) (Pow (space N))" by (simp add: sigma_algebra_Pow)
    show "(x{m. m  n}. {X x -` A  space N |A. A  sets P})  Pow (space N)" by auto
  qed
qed


lemma (in infinite_cts_filtration) stoch_proc_filt_triv_init:
  fixes X::"nat  bool stream  real"
  assumes "borel_adapt_stoch_proc nat_filtration X"
  shows "init_triv_filt M (stoch_proc_filt M X borel)" unfolding init_triv_filt_def
proof
  show "filtration M (stoch_proc_filt M X borel)" using stoch_proc_filt_disc_filtr unfolding  filtration_def
    by (metis adapt_stoch_proc_def assms disc_filtr_def  measurable_from_subalg nat_filtration_subalgebra)
  show "sets (stoch_proc_filt M X borel bot) = {{}, space M}"
  proof -
    have seteq: "sets (stoch_proc_filt M X borel 0) =
      (sigma_sets (space M) ( i {m. m 0}. {(X i -`A)  (space M) | A. A sets borel}))"
    proof (rule stoch_proc_filt_sets)
      show "i. i  0  random_variable borel (X i)"
      proof -
        fix i::nat
        assume "i  0"
        show "random_variable borel (X i)" using assms unfolding adapt_stoch_proc_def
          using filtration_measurable nat_discrete_filtration
          using natural_filtration by blast
      qed
    qed
  have "triv_init_disc_filtr_prob_space M nat_filtration"
    proof (unfold_locales, intro conjI)
      show "disc_filtr M nat_filtration" unfolding disc_filtr_def
        using filtrationE2 nat_discrete_filtration nat_filtration_subalgebra  by auto
      show "sets (nat_filtration ) = {{}, space M}" using nat_info_filtration unfolding init_triv_filt_def by simp
    qed
    hence "c. w  space M. ((X 0 w)::real) = c" using assms
        triv_init_disc_filtr_prob_space.adapted_init[of M nat_filtration X] by simp
    from this obtain c where img: "w  space M. (X 0 w) = c" by auto
    have "( i {m. m 0}. {(X i -`A)  (space M) | A. A sets borel}) =
      {(X 0 -`A)  (space M) | A. A sets borel}" by auto
    also have "... = {{}, space M}"
    proof
      show "{X 0 -` A  space M |A. A  sets borel}  {{}, space M}"
      proof -
        have "A  sets borel. (X 0 -`A)  (space M)  {{}, space M}"
        proof
          fix A::"real set"
          assume "A sets borel"
          show "(X 0 -`A)  (space M)  {{}, space M}"
          proof (cases "c A")
            case True
            hence "X 0 -` A  space M = space M" using img by auto
            thus ?thesis by simp
          next
            case False
            hence "X 0 -` A  space M = {}" using img by auto
            thus ?thesis by simp
          qed
        qed
        thus ?thesis by auto
      qed
      show "{{}, space M}  {X 0 -` A  space M |A. A  sets borel}"
      proof -
        have "{}  {X 0 -` A  space M |A. A  sets borel}" by blast
        moreover have "space M  {X 0 -` A  space M |A. A  sets borel}"
        proof -
          have "UNIV  X 0 -` space borel"
            using space_borel by blast
          then show ?thesis
            using bernoulli_stream_space by blast
        qed
        ultimately show ?thesis by auto
      qed
    qed
    finally have "( i {m. m 0}. {(X i -`A)  (space M) | A. A sets borel}) = {{}, space M}" .
    moreover have "sigma_sets (space M) {{}, space M} = {{}, space M}"
    proof -
      have "sigma_sets (space M) {space M} = {{}, space M}" by simp
      have "sigma_sets (space M) (sigma_sets (space M) {space M}) = sigma_sets (space M) {space M}"
        by (rule sigma_sets_sigma_sets_eq, simp)
      also have "... = {{}, space M}" by simp
      finally show ?thesis by simp
    qed
    ultimately show ?thesis using seteq by (simp add: bot_nat_def)
  qed
qed

lemma (in infinite_cts_filtration) stream_space_borel_union:
fixes X::"nat  bool stream  ('b::t2_space)"
  assumes "borel_adapt_stoch_proc F X"
  and "i n"
  and "A sets borel"
shows "y A range (X i). X i -`{y} = (proj_stoch_proc X n) -` (z comp_proj_i X n i y.
    (stream_space_single (proj_stoch_proc X n) z))"
proof
  fix y
  assume "y A range (X i)"
  hence "x. y = X i x" by auto
  from this obtain x where "y = X i x" by auto
  hence "X i -`{y} = X i -`{X i x}" by simp
  also have "... = (z comp_proj_i X n i (X i x). (proj_stoch_proc X n) -` {z})"
    using i n by (simp add: stoch_proc_comp_proj_i_preimage)
  also have "... = (z comp_proj_i X n i (X i x). (proj_stoch_proc X n) -`
    (stream_space_single (proj_stoch_proc X n) z))"
  proof -
    have "z comp_proj_i X n i (X i x). (proj_stoch_proc X n) -` {z} = (proj_stoch_proc X n) -`
      (stream_space_single (proj_stoch_proc X n) z)"
    proof
      fix z
      assume "z  comp_proj_i X n i (X i x)"
      have "stream_space_single (proj_stoch_proc X n) z  range (proj_stoch_proc X n) = {z}"
        using stream_space_single_preimage assms
      proof -
        have "z  range (proj_stoch_proc X n)"
          using z  comp_proj_i X n i (X i x) comp_proj_i_def by force
        then show ?thesis
          by (meson assms stream_space_single_preimage)
      qed
      thus "(proj_stoch_proc X n) -` {z} = (proj_stoch_proc X n) -`
        (stream_space_single (proj_stoch_proc X n) z)" by auto
    qed
    thus ?thesis by auto
  qed
  also have "... = proj_stoch_proc X n -` (z comp_proj_i X n i y. (stream_space_single (proj_stoch_proc X n) z))"
    by (simp add: y = X i x vimage_Union)
  finally show "X i -`{y} = (proj_stoch_proc X n) -` (z comp_proj_i X n i y.
    (stream_space_single (proj_stoch_proc X n) z))" using y = X i x by simp
qed



lemma (in infinite_cts_filtration) proj_stoch_pre_borel:
  fixes X::"nat  bool stream  ('b::t2_space)"
  assumes "borel_adapt_stoch_proc F X"
  shows "proj_stoch_proc X n -` {proj_stoch_proc X n x}  sets (stoch_proc_filt M X borel n)"
proof -
  have "proj_stoch_proc X n -` {proj_stoch_proc X n x} = ( i {m. mn}. (X i) -`{X i x})"
    by (simp add:comp_proj_stoch_proc_preimage)
  also have "...  sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets borel})"
  proof -
    have inset: "in. (X i) -`{X i x}  {X i -` A  space M |A. A  sets borel}"
    proof (intro allI impI)
      fix i
      assume "i  n"
      have "U. open U  U (range (X i)) = {X i x}"
      proof -
        have "U. open U  X i x U  U ((range (X i))-{X i x}) = {}"
        proof (rule open_except_set)
          have "finite (range (X i))" using assms
            by (metis adapt_stoch_proc_def bernoulli bernoulli_stream_space
              nat_filtration_vimage_finite natural_filtration streams_UNIV)
          thus "finite (range (X i) -{X i x})" by auto
          show "X i x (range (X i)) -{X i x}" by simp
        qed
        thus ?thesis using assms by auto
      qed
      from this obtain U where "open U" and "U (range (X i)) = {X i x}" by auto
      have "X i -` {X i x} = X i -`U" using U (range (X i)) = {X i x} by auto
      also have "... = X i -` U  space M" using bernoulli bernoulli_stream_space by simp
      finally have "X i -` {X i x} = X i -` U  space M" .
      moreover have "U  sets borel" using ‹open U by simp
      ultimately show "(X i) -`{X i x}  {X i -` A  space M |A. A  sets borel}" by auto
    qed
    show ?thesis
    proof (rule sigma_set_inter_init)
      show "(i{m. m  n}. {X i -` A  space M |A. A  sets borel})  Pow (space M)" by auto
      show "i. i  n  X i -` {X i x}  sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets borel})"
        using inset by (metis (no_types, lifting) UN_I mem_Collect_eq sigma_sets.Basic)
    qed
  qed
  also have "... = sets (stoch_proc_filt M X borel n)"
  proof (rule stoch_proc_filt_sets[symmetric])
    fix i
    assume "i  n"
    show "random_variable borel (X i)" using assms borel_adapt_stoch_proc_borel_measurable by blast
  qed
  finally show "proj_stoch_proc X n -` {proj_stoch_proc X n x}
     sets (stoch_proc_filt M X borel n)" .
qed



lemma (in infinite_cts_filtration) stoch_proc_filt_gen:
fixes X::"nat  bool stream  ('b::t2_space)"
  assumes "borel_adapt_stoch_proc F X"
  shows "stoch_proc_filt M X borel n = fct_gen_subalgebra M (stream_space borel) (proj_stoch_proc X n)"
proof -
  have "(i{m. m  n}. {X i -` A  space M |A. A  sets borel})
     {proj_stoch_proc X n -` B  space M |B. B  sets (stream_space borel)}"
  proof (rule UN_subset_iff[THEN iffD2], intro ballI)
    fix i
    assume "i {m. mn}"
    hence "i  n" by simp
    show "{X i -` A  space M |A. A  sets borel} 
      {proj_stoch_proc X n -` B  space M |B. B  sets (stream_space borel)}"
    proof -
      have "A. A sets borel  X i -` A  space M  {proj_stoch_proc X n -` B  space M |B. B  sets (stream_space borel)}"
      proof -
        fix A::"'b set"
        assume "A sets borel"
        have "X i -`A  space M = X i -` A" using bernoulli bernoulli_stream_space by simp
        also have "... = X i -`(A range (X i))" by auto
        also have "... = ( y A range (X i). X i -`{y})" by auto
        also have "... = ( y A range (X i). (proj_stoch_proc X n) -` (z comp_proj_i X n i y.
            (stream_space_single (proj_stoch_proc X n) z)))" using stream_space_borel_union assms in Asets borel›
          by (metis (mono_tags, lifting) image_cong)
        also have "... = (proj_stoch_proc X n) -` ( y A range (X i). (z comp_proj_i X n i y.
            (stream_space_single (proj_stoch_proc X n) z)))" by (simp add: vimage_Union)
        finally have "X i -`A  space M = (proj_stoch_proc X n) -` ( y A range (X i). (z comp_proj_i X n i y.
            (stream_space_single (proj_stoch_proc X n) z)))" .
        moreover have "( y A range (X i). (z comp_proj_i X n i y.
            (stream_space_single (proj_stoch_proc X n) z)))  sets (stream_space borel)"
        proof -
          have "finite (A range (X i))"
          proof -
            have "finite (range (X i))" using assms
              by (metis adapt_stoch_proc_def bernoulli bernoulli_stream_space
                  nat_filtration_vimage_finite natural_filtration streams_UNIV)
            thus ?thesis by auto
          qed
          moreover have "y A range (X i). (z comp_proj_i X n i y.
            (stream_space_single (proj_stoch_proc X n) z))  sets (stream_space borel)"
          proof
            fix y
            assume "y A range (X i)"
            have "finite (comp_proj_i X n i y)" by (simp add: assms comp_proj_i_finite)
            moreover have "z comp_proj_i X n i y. (stream_space_single (proj_stoch_proc X n) z)  sets (stream_space borel)"
            proof
              fix z
              assume "z comp_proj_i X n i y"
              thus "(stream_space_single (proj_stoch_proc X n) z)  sets (stream_space borel)" using assms
                stream_space_single_set unfolding comp_proj_i_def by auto
            qed
            ultimately show "(z comp_proj_i X n i y. (stream_space_single (proj_stoch_proc X n) z)) 
              sets (stream_space borel)" by blast
          qed
          ultimately show ?thesis by blast
        qed
        ultimately show "X i -` A  space M  {proj_stoch_proc X n -` B  space M |B. B  sets (stream_space borel)}"
          by (metis (mono_tags, lifting) X i -` A  space M = X i -` A mem_Collect_eq)
      qed
      thus ?thesis by auto
    qed
  qed
  hence l: "sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets borel}) 
    sigma_sets (space M) {proj_stoch_proc X n -` B  space M |B. B  sets (stream_space borel)}"
    by (rule sigma_sets_mono')
  have "{proj_stoch_proc X n -` B  space M |B. B  sets (stream_space borel)}
       sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets borel})"
  proof -
    have "B sets (stream_space borel). proj_stoch_proc X n -` B  space M 
      sigma_sets (space M) ( i {m. m n}. {(X i -`A)  (space M) | A. A sets borel })"
    proof
      fix B::"'b stream set"
      assume "B sets (stream_space borel)"
      have "proj_stoch_proc X n -` B  space M = proj_stoch_proc X n -`B" using bernoulli bernoulli_stream_space by simp
      also have "... = proj_stoch_proc X n -` (B  range (proj_stoch_proc X n))" by auto
      also have "... = proj_stoch_proc X n -` ( y (B  range (proj_stoch_proc X n)). {y})" by simp
      also have "... = ( y (B  range (proj_stoch_proc X n)).  proj_stoch_proc X n -`{y})" by auto
      finally have eqB: "proj_stoch_proc X n -` B  space M =
        ( y (B  range (proj_stoch_proc X n)). proj_stoch_proc X n -`{y})" .
      have "y (B  range (proj_stoch_proc X n)). proj_stoch_proc X n -`{y} 
        sigma_sets (space M) ( i {m. m n}. {(X i -`A)  (space M) | A. A sets borel })"
      proof
        fix y
        assume "y  B  range (proj_stoch_proc X n)"
        hence "x. y = proj_stoch_proc X n x" by auto
        from this obtain x where "y = proj_stoch_proc X n x" by auto
        have "proj_stoch_proc X n -`{proj_stoch_proc X n x}  sets (stoch_proc_filt M X borel n)"
          by (rule proj_stoch_pre_borel, simp add:assms)
        also have "... = sigma_sets (space M) ( i {m. m n}. {(X i -`A)  (space M) | A. A sets borel })"
        proof (rule stoch_proc_filt_sets)
          fix i
          assume "i n"
          show "random_variable borel (X i)" using assms borel_adapt_stoch_proc_borel_measurable by blast
        qed
        finally show "proj_stoch_proc X n -`{y} 
          sigma_sets (space M) ( i {m. m n}. {(X i -`A)  (space M) | A. A sets borel })"
          using y = proj_stoch_proc X n x by simp
      qed
      hence "( y (B  range (proj_stoch_proc X n)). proj_stoch_proc X n -`{y}) 
        sigma_sets (space M) ( i {m. m n}. {(X i -`A)  (space M) | A. A sets borel })"
      proof (rule sigma_set_union_count)
        have "finite (range (proj_stoch_proc X n))"
          by (simp add: assms proj_stoch_set_finite_range)
        thus "countable (B  range (proj_stoch_proc X n))"
          by (simp add: countable_finite)
      qed
      thus "proj_stoch_proc X n -` B  space M 
        sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets borel})" using eqB by simp
    qed
    thus ?thesis by auto
  qed
  hence "sigma_sets (space M) {proj_stoch_proc X n -` B  space M |B. B  sets (stream_space borel)}
     sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets borel})" by (rule sigma_sets_mono)
  hence "sigma_sets (space M) {proj_stoch_proc X n -` B  space M |B. B  sets (stream_space borel)}
    = sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets borel})" using l by simp
  thus ?thesis unfolding stoch_proc_filt_def fct_gen_subalgebra_def by simp
qed


lemma (in infinite_coin_toss_space) stoch_proc_subalg_nat_filt:
  assumes "borel_adapt_stoch_proc nat_filtration X"
  shows "subalgebra (nat_filtration n) (stoch_proc_filt M X borel n)" unfolding subalgebra_def
proof
  show "space (stoch_proc_filt M X borel n) = space (nat_filtration n)"
    by (simp add: fct_gen_subalgebra_space nat_filtration_def stoch_proc_filt_space)
  show "sets (stoch_proc_filt M X borel n)  sets (nat_filtration n)"
  proof -
    have "i  n. ( A sets borel. X i -`A  space M  sets (nat_filtration n))"
    proof (intro allI impI)
      fix i
      assume "i  n"
      have "X i  borel_measurable (nat_filtration n)"
        by (metis i  n adapt_stoch_proc_def assms filtrationE2 measurable_from_subalg nat_discrete_filtration)
      show "Asets borel. X i -` A  space M  sets (nat_filtration n)"
      proof
        fix A::"'a set"
        assume "A sets borel"
        thus "X i -` A  space M  sets (nat_filtration n)" using X i  borel_measurable (nat_filtration n)
          by (metis bernoulli bernoulli_stream_space measurable_sets nat_filtration_space streams_UNIV)
      qed
    qed
    hence "( i {m. m n}. {(X i -`A)  (space M) | A. A sets borel })  sets (nat_filtration n)" by auto
    hence "sigma_sets (space M) ( i {m. m n}. {(X i -`A)  (space M) | A. A sets borel })  sets (nat_filtration n)"
      by (metis (no_types, lifting) bernoulli bernoulli_stream_space nat_filtration_space sets.sigma_sets_subset streams_UNIV)
    thus ?thesis using assms stoch_proc_filt_sets unfolding adapt_stoch_proc_def
    proof -
    assume "t. X t  borel_measurable (nat_filtration t)"
      then have f1: "n m. X n  borel_measurable m  ¬ subalgebra m (nat_filtration n)"
        by (meson measurable_from_subalg)
      have "n. subalgebra M (nat_filtration n)"
        by (metis infinite_coin_toss_space.nat_filtration_subalgebra infinite_coin_toss_space_axioms)
      then show ?thesis
        using f1 n X N M. (i. i  n  X i  M M N)  sets (stoch_proc_filt M X N n) = sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets N}) ‹sigma_sets (space M) (i{m. m  n}. {X i -` A  space M |A. A  sets borel})  sets (nat_filtration n) by blast
    qed
  qed
qed




lemma (in infinite_coin_toss_space)
  assumes "N = bernoulli_stream q"
  and "0  q"
  and "q  1"
  and "0 < p"
  and "p < 1"
  and "filt_equiv nat_filtration M N"
  shows filt_equiv_sgt: "0 < q" and filt_equiv_slt: "q < 1"
proof -
  have "space M = space N" using assms filt_equiv_space by simp
  have eqs: "{w space M. (snth w 0)} = pseudo_proj_True (Suc 0) -`{True ##sconst True}"
  proof
    show "{w  space M. w !! 0}  pseudo_proj_True (Suc 0) -` {True ##sconst True}"
    proof
      fix w
      assume "w  {w  space M. w !! 0}"
      hence "snth w 0" by simp
      hence "pseudo_proj_True (Suc 0) w = True##sconst True" by (simp add: pseudo_proj_True_def)
      thus "w  pseudo_proj_True (Suc 0) -` {True##sconst True}" by simp
    qed
    show "pseudo_proj_True (Suc 0) -` {True##sconst True}  {w  space M. w !! 0}"
    proof
      fix w
      assume "w  pseudo_proj_True (Suc 0) -` {True##sconst True}"
      hence "pseudo_proj_True (Suc 0) w = True##sconst True" by simp
      hence "snth w 0"
        by (metis pseudo_proj_True_Suc_prefix stream_eq_Stream_iff)
      thus "w {w  space M. w !! 0}" using bernoulli bernoulli_stream_space by simp
    qed
  qed
  hence natset: "{w space M. (snth w 0)}  sets (nat_filtration (Suc 0))"
  proof -
    have "pseudo_proj_True (Suc 0) -` {True##sconst True}  sets (nat_filtration (Suc 0))"
    proof (rule nat_filtration_singleton)
      show "pseudo_proj_True (Suc 0) (True##sconst True) = True## sconst True" unfolding pseudo_proj_True_def by simp
    qed
    thus ?thesis using eqs by simp
  qed
  have eqf: "{w space M. ¬(snth w 0)} = pseudo_proj_True (Suc 0) -`{False ##sconst True}"
  proof
    show "{w  space M. ¬(snth w 0)}  pseudo_proj_True (Suc 0) -` {False ##sconst True}"
    proof
      fix w
      assume "w  {w  space M. ¬(snth w 0)}"
      hence "¬(snth w 0)" by simp
      hence "pseudo_proj_True (Suc 0) w = False ##sconst True"
        by (simp add: pseudo_proj_True_def)
      thus "w  pseudo_proj_True (Suc 0) -` {False ## sconst True}" by simp
    qed
    show "pseudo_proj_True (Suc 0) -` {False ## sconst True}  {w  space M. ¬(snth w 0)}"
    proof
      fix w
      assume "w  pseudo_proj_True (Suc 0) -` {False##sconst True}"
      hence "pseudo_proj_True (Suc 0) w = False##sconst True" by simp
      hence "¬(snth w 0)"
        by (metis pseudo_proj_True_Suc_prefix  stream_eq_Stream_iff)
      thus "w {w  space M. ¬(snth w 0)}" using bernoulli bernoulli_stream_space by simp
    qed
  qed
  hence natsetf: "{w space M. ¬(snth w 0)}  sets (nat_filtration (Suc 0))"
  proof -
    have "pseudo_proj_True (Suc 0) -` {False##sconst True}  sets (nat_filtration (Suc 0))"
    proof (rule nat_filtration_singleton)
      show "pseudo_proj_True (Suc 0) (False##sconst True) = False##sconst True" unfolding pseudo_proj_True_def by simp
    qed
    thus ?thesis using eqf by simp
  qed
  (*have "prob_space N" using assms
        by (simp add: bernoulli_stream_def prob_space.prob_space_stream_space
            prob_space_measure_pmf)*)
  show "0 < q"
  proof (rule ccontr)
    assume "¬ 0 < q"
    hence "q = 0" using assms by simp
    hence "emeasure N {w space N. (snth w 0)} = q" using bernoulli_stream_component_probability[of N q]
        assms by blast
    hence "emeasure N {w space N. (snth w 0)} = 0" using q = 0 by simp
    hence "emeasure M {w space M. (snth w 0)} = 0" using assms natset unfolding filt_equiv_def
      by (simp add: ‹space M = space N)
    moreover have "emeasure M {w space M. (snth w 0)} = p" using bernoulli_stream_component_probability[of M p] bernoulli
        p_lt_1 p_gt_0 by blast
    ultimately show False using assms by simp
  qed
  show "q < 1"
  proof (rule ccontr)
    assume "¬ q < 1"
    hence "q = 1" using assms by simp
    hence "emeasure N {w space N. ¬(snth w 0)} = 1 -q" using bernoulli_stream_component_probability_compl[of N q]
        assms by blast
    hence "emeasure N {w space N. ¬(snth w 0)} = 0" using q = 1 by simp
    hence "emeasure M {w space M. ¬(snth w 0)} = 0" using assms natsetf unfolding filt_equiv_def
      by (simp add: ‹space M = space N)
    moreover have "emeasure M {w space M. ¬(snth w 0)} = 1-p" using bernoulli_stream_component_probability_compl[of M p] bernoulli
        p_lt_1 p_gt_0 by blast
    ultimately show False using assms by simp
  qed
qed

lemma stoch_proc_filt_filt_equiv:
  assumes "filt_equiv F M N"
  shows "stoch_proc_filt M f P n = stoch_proc_filt N f P n" using assms filt_equiv_space filt_equiv_sets
  unfolding stoch_proc_filt_def
proof -
  have "space N = space M"
    by (metis assms filt_equiv_space)
  then show "gen_subalgebra M (sigma_sets (space M) (n{na. na  n}. {f n -` C  space M |C. C  sets P})) =
    gen_subalgebra N (sigma_sets (space N) (n{na. na  n}. {f n -` C  space N |C. C  sets P}))"
    by (simp add: gen_subalgebra_def)
qed

lemma  filt_equiv_filt:
  assumes "filt_equiv F M N"
and "filtration M G"
shows "filtration N G" unfolding filtration_def
proof (intro allI conjI impI)
  {
    fix t
    show "subalgebra N (G t)" using assms unfolding filtration_def filt_equiv_def
      by (metis sets_eq_imp_space_eq subalgebra_def)
  }
  {
    fix s::'c
    fix t
    assume "s  t"
    thus "subalgebra (G t) (G s)" using assms unfolding filtration_def by simp
  }
qed


lemma  filt_equiv_borel_AE_eq_iff:
  fixes f::"'a real"
  assumes "filt_equiv F M N"
and "f borel_measurable (F t)"
and "g borel_measurable (F t)"
and "prob_space N"
and "prob_space M"
shows "(AE w in M. f w = g w)  (AE w in N. f w = g w)"
proof -
  {
    assume fst: "AE w in M. f w = g w"
    have set0: "{w space M. f w  g w}  sets (F t)  emeasure M {w space M. f w  g w} = 0"
    proof (rule filtrated_prob_space.AE_borel_eq, (auto simp add: assms))
      show "filtrated_prob_space M F" using assms  unfolding filt_equiv_def
        by (simp add: filtrated_prob_space_axioms.intro filtrated_prob_space_def)
      show "AE w in M. f w =  g w" using fst .
    qed
    hence "emeasure N {w space M. f w  g w} = 0" using assms unfolding filt_equiv_def by auto
    moreover have "{w space M. f w  g w}  sets N" using set0 assms unfolding filt_equiv_def
      filtration_def subalgebra_def by auto
    ultimately have "AE w in N. f w = g w"
    proof -
    have "space M = space N"
      by (metis assms(1) filt_equiv_space)
      then have "p. almost_everywhere N p  {a  space N. ¬ p a}  {a  space N. f a  g a}"
        using AE_iff_measurable ‹emeasure N {w  space M. f w  g w} = 0 {w  space M. f w  g w}  sets N
        by auto
      then show ?thesis
        by metis
    qed
  } note a = this
  {
    assume scd: "AE w in N. f w = g w"
    have "space M = space N"
      by (metis assms(1) filt_equiv_space)
    have set0: "{w space N. f w  g w}  sets (F t)  emeasure N {w space N. f w  g w} = 0"
    proof (rule filtrated_prob_space.AE_borel_eq, (auto simp add: assms))
      show "filtrated_prob_space N F" using assms unfolding filt_equiv_def
        by (metis ‹prob_space N assms(1) filt_equiv_filtration filtrated_prob_space_axioms.intro filtrated_prob_space_def)
      show "AE w in N. f w = g w" using scd .
    qed
    hence "emeasure M {w space M. f w  g w} = 0" using assms unfolding filt_equiv_def
      by (metis (full_types) assms(1) filt_equiv_space)
    moreover have "{w space M. f w  g w}  sets M" using set0 assms unfolding filt_equiv_def
      filtration_def subalgebra_def
      by (metis (mono_tags) ‹space M = space N contra_subsetD)
    ultimately have "AE w in M. f w=  g w"
    proof -
       have "p. almost_everywhere M p  {a  space M. ¬ p a}  {a  space M. f a  g a}"
        using AE_iff_measurable ‹emeasure M {w  space M. f w  g w} = 0 {w  space M. f w  g w}  sets M
        by auto
      then show ?thesis
        by metis
    qed
  }
  thus ?thesis using a by auto
qed

lemma (in infinite_coin_toss_space) filt_equiv_triv_init:
  assumes "filt_equiv F M N"
and "init_triv_filt M G"
shows "init_triv_filt N G" unfolding init_triv_filt_def
proof
  show "filtration N G" using assms filt_equiv_filt[of F M N G] unfolding init_triv_filt_def by simp
  show "sets (G ) = {{}, space N}" using assms filt_equiv_space[of F M N] unfolding init_triv_filt_def by simp
qed



lemma (in infinite_coin_toss_space) fct_gen_subalgebra_meas_info:
  assumes "w. f (g w) = f w"
  and "f  space M  space N"
and "g  space M  space M"
  shows "g  measurable (fct_gen_subalgebra M N f) (fct_gen_subalgebra M N f)" unfolding measurable_def
proof (intro CollectI conjI)
  show "g  space (fct_gen_subalgebra M N f)  space (fct_gen_subalgebra M N f)" using assms
    by (simp add: fct_gen_subalgebra_space)
  show "ysets (fct_gen_subalgebra M N f). g -` y  space (fct_gen_subalgebra M N f)  sets (fct_gen_subalgebra M N f)"
  proof
    fix B
    assume "B sets (fct_gen_subalgebra M N f)"
    hence "B  {f -` B  space M |B. B  sets N}" using assms by (simp add:fct_gen_subalgebra_sigma_sets)
    from this obtain C where "C sets N" and "B = f -`C  space M" by auto note Cprops = this
    have "g -` B  space (fct_gen_subalgebra M N f) = g -` B  space M" using assms
      by (simp add: fct_gen_subalgebra_space)
    also have "... = g -` (f -` C  space M)  space M" using Cprops by simp
    also have "... = g -` (f -` C)" using bernoulli bernoulli_stream_space by simp
    also have "... = (f g) -` C" by auto
    also have "... = f -` C"
    proof
      show "(f  g) -` C  f -` C"
      proof
        fix w
        assume "w  (f  g) -` C"
        hence "f (g w)  C" by simp
        hence "f w  C" using assms by simp
        thus "w f -`C" by simp
      qed
      show "f -` C  (f  g) -` C"
      proof
        fix w
        assume "w f -`C"
        hence "f w  C" by simp
        hence "f (g w)  C" using assms by simp
        thus "w (f  g) -` C" by simp
      qed
    qed
    also have "...  sets (fct_gen_subalgebra M N f)"
      using Cprops(2) B  sets (fct_gen_subalgebra M N f) bernoulli bernoulli_stream_space
        inf_top.right_neutral by auto
    finally show "g -` B  space (fct_gen_subalgebra M N f)  sets (fct_gen_subalgebra M N f)" .
  qed
qed



end

Theory Geometric_Random_Walk

theory Geometric_Random_Walk imports Infinite_Coin_Toss_Space

begin

section ‹Geometric random walk›
text ‹A geometric random walk is a stochastic process that can, at each time, move upwards or downwards,
depending on the outcome of a coin toss.›

fun (in infinite_coin_toss_space) geom_rand_walk:: "real  real  real  (nat  bool stream  real)" where
  base: "(geom_rand_walk u d v) 0 = (λw. v)"|
  step: "(geom_rand_walk u d v) (Suc n)  = (λw. ((λTrue  u | False  d) (snth w n)) * (geom_rand_walk u d v) n w)"


locale prob_grw = infinite_coin_toss_space +
  fixes geom_proc::"nat  bool stream  real" and u::real and d::real and init::real
  assumes geometric_process:"geom_proc = geom_rand_walk u d init"

lemma (in prob_grw) geom_rand_walk_borel_measurable:
shows "(geom_proc n)  borel_measurable M"
proof (induct n)
case (Suc n)
  thus "geom_proc (Suc n)  borel_measurable M"
  proof -
    have "geom_rand_walk u d init n  borel_measurable M" using Suc geometric_process by simp
    moreover have "(λw. ((λTrue  u | False  d) (snth w n)))  borel_measurable M"
    proof -
      have "(λw. snth w n)  measurable M (measure_pmf (bernoulli_pmf p))" by (simp add: bernoulli measurable_snth_count_space)
      moreover have "(λTrue  u | False  d)  borel_measurable (measure_pmf (bernoulli_pmf p))" by simp
      ultimately show ?thesis by (simp add: measurable_comp)
    qed
    ultimately show ?thesis by (simp add:borel_measurable_times geometric_process)
  qed
  next
  show "random_variable borel (geom_proc 0)" using geometric_process by simp
qed



lemma (in prob_grw) geom_rand_walk_pseudo_proj_True:
shows "geom_proc n = geom_proc n  pseudo_proj_True n"
proof (induct n)
case (Suc n)
  let ?tf = "(λTrue  u | False  d)"
  {
    fix w
    have "geom_proc (Suc n) w  =  ?tf  (snth w n) * geom_proc n w"
      using geom_rand_walk.simps(2) geometric_process by simp
    also have "... = ?tf (snth (pseudo_proj_True (Suc n) w) n) * geom_proc n w"
      by (metis  lessI pseudo_proj_True_stake stake_nth)
    also have "... = ?tf (snth (pseudo_proj_True (Suc n) w) n) * geom_proc n (pseudo_proj_True n w)"
      using Suc geometric_process by (metis comp_apply)
    also have "... = ?tf (snth (pseudo_proj_True (Suc n) w) n) * geom_proc n (pseudo_proj_True (Suc n) w)"
      using geometric_process by (metis Suc.hyps comp_apply pseudo_proj_True_proj_Suc)
    also have "... = geom_proc (Suc n) (pseudo_proj_True (Suc n) w)" using geometric_process by simp
    finally have "geom_proc (Suc n) w  = geom_proc (Suc n) (pseudo_proj_True (Suc n) w)" .
  }
  thus "geom_proc (Suc n) = geom_proc (Suc n)  (pseudo_proj_True  (Suc n))" using geometric_process by auto
next
  show "geom_proc 0 = geom_proc 0  pseudo_proj_True 0" using geometric_process by auto
qed

lemma (in prob_grw) geom_rand_walk_pseudo_proj_False:
shows "geom_proc n = geom_proc n  pseudo_proj_False n"
proof (induct n)
case (Suc n)
  let ?tf = "(λTrue  u | False  d)"
  {
    fix w
    have "geom_proc (Suc n) w  =  ?tf  (snth w n) * geom_proc n w"
      using geom_rand_walk.simps(2) geometric_process by simp
    also have "... = ?tf (snth (pseudo_proj_False (Suc n) w) n) * geom_proc n w"
      by (metis  lessI pseudo_proj_False_stake stake_nth)
    also have "... = ?tf (snth (pseudo_proj_False (Suc n) w) n) * geom_proc n (pseudo_proj_False n w)"
      using Suc geometric_process by (metis comp_apply)
    also have "... = ?tf (snth (pseudo_proj_False (Suc n) w) n) * geom_proc n (pseudo_proj_True n (pseudo_proj_False n w))"
      using  geometric_process by (metis geom_rand_walk_pseudo_proj_True o_apply)
    also have "... = ?tf (snth (pseudo_proj_False (Suc n) w) n) * geom_proc n (pseudo_proj_True n (pseudo_proj_False (Suc n) w))"
      unfolding pseudo_proj_True_def pseudo_proj_False_def
      by (metis pseudo_proj_False_def pseudo_proj_False_stake pseudo_proj_True_def pseudo_proj_True_proj_Suc)
    also have "... = ?tf (snth (pseudo_proj_False (Suc n) w) n) * geom_proc n (pseudo_proj_False (Suc n) w)"
      using geometric_process by (metis geom_rand_walk_pseudo_proj_True o_apply)
    also have "... = geom_proc (Suc n) (pseudo_proj_False (Suc n) w)" using geometric_process by simp
    finally have "geom_proc (Suc n) w  = geom_proc (Suc n) (pseudo_proj_False (Suc n) w)" .
  }
  thus "geom_proc (Suc n) = geom_proc (Suc n)  (pseudo_proj_False  (Suc n))" using geometric_process by auto
next
  show "geom_proc 0 = geom_proc 0  pseudo_proj_False 0" using geometric_process by auto
qed



lemma (in prob_grw) geom_rand_walk_borel_adapted:
  shows "borel_adapt_stoch_proc nat_filtration geom_proc"
unfolding adapt_stoch_proc_def
proof (auto simp add:nat_discrete_filtration)
  fix n
  show "geom_proc n  borel_measurable (nat_filtration n)"
  proof -
    have "geom_proc n  borel_measurable (nat_filtration n)"
    proof (rule nat_filtration_comp_measurable)
      show "geom_proc n  borel_measurable M"
        by (simp add: geom_rand_walk_borel_measurable)
      show "geom_proc n  pseudo_proj_True n = geom_proc n"
        using geom_rand_walk_pseudo_proj_True  by simp
    qed
    then show ?thesis by simp
  qed
qed


lemma (in prob_grw) grw_succ_img:
  assumes "(geom_proc n) -` {x}  {}"
  shows "(geom_proc (Suc n)) ` ((geom_proc n) -` {x}) = {u*x, d*x}"
proof
  have " w. geom_proc n w = x" using assms by auto
  from this obtain w where "geom_proc n w = x" by auto
  let ?wT = "spick w n True"
  let ?wF = "spick w n False"
  have bel: "(?wT  (geom_proc n) -` {x})  (?wF  (geom_proc n) -` {x})"
    by (metis geom_proc n w = x geom_rand_walk_pseudo_proj_True o_def
        pseudo_proj_True_stake_image spickI vimage_singleton_eq)
  have "geom_proc (Suc n) ?wT = u*x"
  proof -
    have "x = geom_rand_walk u d init n (spick w n True)"
      by (metis geom_proc n w = x comp_apply geom_rand_walk_pseudo_proj_True geometric_process pseudo_proj_True_stake_image spickI)
    then show ?thesis
      by (simp add: geometric_process spickI)
  qed
  moreover have "geom_proc (Suc n) ?wF = d*x"
  proof -
    have "x = geom_rand_walk u d init n (spick w n False)"
      by (metis geom_proc n w = x comp_apply geom_rand_walk_pseudo_proj_True geometric_process pseudo_proj_True_stake_image spickI)
    then show ?thesis
      by (simp add: geometric_process spickI)
  qed
  ultimately show "{u*x, d*x}  (geom_proc (Suc n)) ` ((geom_proc n) -` {x})" using bel
    by (metis empty_subsetI insert_subset rev_image_eqI)
  have "w  (geom_proc n) -` {x}. geom_proc (Suc n) w  {u*x, d*x}"
  proof
    fix w
    assume "w  (geom_proc n) -` {x}"
    have dis: "((snth w (Suc n)) = True)  (snth w (Suc n) = False)" by simp
    show "geom_proc (Suc n) w  {u*x, d*x}"
    proof -
      have "geom_proc n w = x"
        by (metis w  geom_proc n -` {x} vimage_singleton_eq)
      then have "geom_rand_walk u d init n w = x"
        using geometric_process by blast
      then show ?thesis
        by (simp add: case_bool_if geometric_process)
    qed
  qed
  thus "(geom_proc (Suc n)) ` ((geom_proc n) -` {x})  {u*x, d*x}" by auto
qed

lemma (in prob_grw) geom_rand_walk_strictly_positive:
  assumes "0 < init"
  and "0 < d"
  and "d < u"
  shows " n w. 0 < geom_proc n w"
proof (intro allI)
  fix n
  fix w
  show "0 < geom_proc n w"
  proof (induct n)
  case 0 thus ?case using assms geometric_process by simp
  next
  case (Suc n)
    thus ?case
    proof (cases "snth w n")
    case True
      hence "geom_proc (Suc n) w = u * geom_proc n w" using geom_rand_walk.simps geometric_process by simp
      also have "... > 0" using Suc assms  by simp
      finally show ?thesis .
    next
    case False
      hence "geom_proc (Suc n) w = d * geom_proc n w" using geom_rand_walk.simps geometric_process by simp
      also have "... > 0" using Suc assms by simp
      finally show ?thesis .
    qed
  qed
qed


lemma (in prob_grw) geom_rand_walk_diff_induct:
  shows "w. (geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False)) = (geom_proc n w * (u - d))"
proof -
  fix w
  have "geom_proc (Suc n) (spick w n True) = u * geom_proc n w"
  proof -
    have "snth (spick w n True) n = True" by (simp add: spickI)
    hence "(λw. (case w !! n of True  u | False  d)) (spick w n True) = u" by simp
    thus ?thesis using geometric_process geom_rand_walk.simps(2)[of u d init n]
      by (metis comp_apply geom_rand_walk_pseudo_proj_True pseudo_proj_True_def spickI)
  qed
  moreover have "geom_proc (Suc n) (spick w n False) = d * geom_proc n w"
  proof -
    have "snth (spick w n False) n = False" by (simp add: spickI)
    hence "(λw. (case w !! n of True  u | False  d)) (spick w n False) = d" by simp
    thus ?thesis using geometric_process geom_rand_walk.simps(2)[of u d init n]
      by (metis comp_apply geom_rand_walk_pseudo_proj_True pseudo_proj_True_def spickI)
  qed
  ultimately show "(geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False)) = (geom_proc n w * (u - d))"
    by (simp add:field_simps)
qed



end

Theory Fair_Price

(*  Title:      Fair_Price.thy
    Author:     Mnacho Echenim, Univ. Grenoble Alpes
*)

section ‹Fair Prices›

text  ‹This section contains the formalization of financial notions, such as markets, price processes, portfolios,
arbitrages, fair prices, etc. It also defines risk-neutral probability spaces, and proves the main result about the fair
price of a derivative in a risk-neutral probability space, namely that this fair price is equal to the expectation of
the discounted value of the derivative's payoff.›

theory Fair_Price imports Filtration Martingale Geometric_Random_Walk
begin

subsection ‹Preliminary results›

lemma (in prob_space) finite_borel_measurable_integrable:
  assumes "f borel_measurable M"
  and "finite (f`(space M))"
  shows "integrable M f"
proof -
  have "simple_function M f" using assms by (simp add: simple_function_borel_measurable)
  moreover have "emeasure M {y  space M. f y  0}  " by simp
  ultimately have "Bochner_Integration.simple_bochner_integrable M f"
    using Bochner_Integration.simple_bochner_integrable.simps by blast
  hence "has_bochner_integral M f (Bochner_Integration.simple_bochner_integral M f)"
    using has_bochner_integral_simple_bochner_integrable by auto
  thus ?thesis using integrable.simps by auto
qed


subsubsection ‹On the almost everywhere filter›

lemma AE_eq_trans[trans]:
  assumes "AE x in M. A x = B x"
  and "AE x in M. B x = C x"
  shows "AE x in M. A x = C x"
  using assms  by auto


abbreviation AEeq where "AEeq M X Y  AE w in M. X w = Y w"



lemma AE_add:
  assumes "AE w in M. f w = g w"
  and "AE w in M. f' w = g' w"
shows "AE w in M. f w + f' w = g w + g' w" using assms by auto


lemma AE_sum:
  assumes "finite I"
  and  " iI. AE w in M. f i w = g i w"
  shows "AE w in M. (i I. f i w) = (i I. g i w)" using assms(1) subset_refl[of I]
proof (induct rule: finite_subset_induct)
  case empty
  then show ?case by simp
next
  case (insert a F)
  have "AEeq M (f a) (g a)" using assms(2) insert.hyps(2) by auto
  have "AE w in M. (i insert a F. f i w) = f a w + (i F. f i w)"
    by (simp add: insert.hyps(1) insert.hyps(3))
  also have "AE w in M. f a w + (i F. f i w) = g a w + (i F. f i w)"
    using ‹AEeq M (f a) (g a) by auto
  also have "AE w in M. g a w + (i F. f i w) = g a w + (i F. g i w)"
    using insert.hyps(4) by auto
  also have "AE w in M. g a w + (i F. g i w) = (i insert a F. g i w)"
    by (simp add: insert.hyps(1) insert.hyps(3))
  finally show ?case by auto
qed


lemma AE_eq_cst:
  assumes "AE w in M. (λw. c) w = (λw. d) w"
  and "emeasure M (space M)  0"
  shows "c = d"
proof (rule ccontr)
  assume "c  d"
  from AE w in M. (λw. c) w = (λw. d) w obtain N where Nprops: "{w space M. ¬(λw. c) w = (λw. d) w}  N" "N sets M" "emeasure M N = 0"
    by (force elim:AE_E)
  have "w space M. (λw. c) w  (λw. d) w" using c d by simp
  hence "{w space M. (λw. c) w  (λw. d) w} = space M" by auto
  hence "space M N" using Nprops by auto
  thus False using ‹emeasure M N = 0 assms
    by (meson Nprops(2) ‹emeasure M (space M)  0 ‹emeasure M N = 0 ‹space M  N emeasure_eq_0)
qed

subsubsection ‹On conditional expectations›

lemma (in prob_space) subalgebra_sigma_finite:
  assumes "subalgebra M N"
  shows "sigma_finite_subalgebra M N" unfolding sigma_finite_subalgebra_def by (simp add: assms prob_space_axioms prob_space_imp_sigma_finite prob_space_restr_to_subalg)



lemma (in prob_space) trivial_subalg_cond_expect_AE:
  assumes "subalgebra M N"
  and "sets N = {{}, space M}"
  and "integrable M f"
shows "AE x in M. real_cond_exp M N f x = (λx. expectation f) x"
proof (intro sigma_finite_subalgebra.real_cond_exp_charact)
  show "sigma_finite_subalgebra M N" by (simp add: assms(1) subalgebra_sigma_finite)
  show "integrable M f" using assms by simp
  show "integrable M (λx. expectation f)" by auto
  show "(λx. expectation f)  borel_measurable N" by simp
  show "A. A  sets N  set_lebesgue_integral M A f = xA. expectation fM"
  proof -
    fix A
    assume "A  sets N"
    show "set_lebesgue_integral M A f = xA. expectation fM"
    proof (cases "A = {}")
      case True
      thus ?thesis by (simp add: set_lebesgue_integral_def)
    next
      case False
      hence "A = space M" using assms A sets N by auto
      have "set_lebesgue_integral M A f = expectation f" using A = space M
        by (metis (mono_tags, lifting) Bochner_Integration.integral_cong indicator_simps(1)
                  scaleR_one set_lebesgue_integral_def)
      also have "... =xA. expectation fM" using A = space M
        by (auto simp add:prob_space set_lebesgue_integral_def)
      finally show ?thesis .
    qed
  qed
qed

lemma (in prob_space) triv_subalg_borel_eq:
  assumes "subalgebra M F"
  and "sets F = {{}, space M}"
  and "AE x in M. f x = (c::'b::{t2_space})"
  and "f borel_measurable F"
shows "x space M. f x = c"
proof
  fix x
  assume "x space M"
  have "space M = space F" using assms by (simp add:subalgebra_def)
  hence "x space F" using x space M by simp
  have "space M  {}" by (simp add:not_empty)
  hence "d. y space F. f y = d" by (metis assms(1) assms(2) assms(4) subalgebra_def triv_measurable_cst)
  from this obtain d where "y space F. f y = d" by auto
  hence "f x = d" using x space F by simp
  also have "... = c"
  proof (rule ccontr)
    assume "d c"
    from AE x in M. f x= c obtain N where Nprops: "{x space M. ¬f x = c}  N" "N sets M" "emeasure M N = 0"
      by (force elim:AE_E)
    have "space M  {x space M. ¬f x = c}" using y space F. f y = d ‹space M = space F d c by auto
    hence "space M N" using Nprops by auto
    thus False using ‹emeasure M N = 0 emeasure_space_1  Nprops(2) emeasure_mono by fastforce
  qed
  finally show "f x = c" .
qed



lemma (in prob_space) trivial_subalg_cond_expect_eq:
  assumes "subalgebra M N"
  and "sets N = {{}, space M}"
  and "integrable M f"
shows "x space M. real_cond_exp M N f x = expectation f"
proof (rule triv_subalg_borel_eq)
  show "subalgebra M N" "sets N = {{}, space M}" using assms by auto
  show "real_cond_exp M N f  borel_measurable N" by simp
  show "AE x in M. real_cond_exp M N f x = expectation f"
    by (rule trivial_subalg_cond_expect_AE, (auto simp add:assms))
qed



lemma (in sigma_finite_subalgebra) real_cond_exp_cong':
  assumes "w  space M. f w = g w"
  and "f borel_measurable M"
shows "AE w in M. real_cond_exp M F f w = real_cond_exp M F g w"
proof (rule real_cond_exp_cong)
  show "AE w in M. f w = g w" using assms by simp
  show "f borel_measurable M" using assms by simp
  show "g borel_measurable M" using assms by (metis measurable_cong)
qed

lemma (in sigma_finite_subalgebra) real_cond_exp_bsum :
  fixes f::"'b  'a  real"
  assumes [measurable]: "i. iI  integrable M (f i)"
  shows "AE x in M. real_cond_exp M F (λx. iI. f i x) x = (iI. real_cond_exp M F (f i) x)"
proof (rule real_cond_exp_charact)
  fix A assume [measurable]: "A  sets F"
  then have A_meas [measurable]: "A  sets M" by (meson subsetD subalg subalgebra_def)

  have *: "i. i  I  integrable M (λx. indicator A x * f i x)"
    using integrable_mult_indicator[OF A  sets M assms(1)]  by auto
  have **: "i. i  I  integrable M (λx. indicator A x * real_cond_exp M F (f i) x)"
    using integrable_mult_indicator[OF A  sets M real_cond_exp_int(1)[OF assms(1)]]  by auto
  have inti: "i. i  I (x. indicator A x * f i x M) = (x. indicator A x * real_cond_exp M F (f i) x M)" using
      real_cond_exp_intg(2)[symmetric,of "indicator A" ]
    using "*" A  sets F assms borel_measurable_indicator by blast
  have "(xA. (iI. f i x)M) = (x. (iI. indicator A x * f i x)M)"
    by (simp add: sum_distrib_left set_lebesgue_integral_def)
  also have "... = (iI. (x. indicator A x * f i x M))" using Bochner_Integration.integral_sum[of I M "λi x. indicator A x * f i x"] *
    by simp
  also have "... = (iI. (x. indicator A x * real_cond_exp M F (f i) x M))"
    using inti by auto
  also have "... = (x. (iI. indicator A x * real_cond_exp M F (f i) x)M)"
    by (rule Bochner_Integration.integral_sum[symmetric], simp add: **)
  also have "... = (xA. (iI. real_cond_exp M F (f i) x)M)"
    by (simp add: sum_distrib_left set_lebesgue_integral_def)
  finally show "(xA. (iI. f i x)M) = (xA. (iI. real_cond_exp M F (f i) x)M)" by auto
qed (auto simp add: assms real_cond_exp_int(1)[OF assms(1)])

subsection ‹Financial formalizations›

subsubsection ‹Markets›



definition stk_strict_subs::"'c set  bool" where
"stk_strict_subs S  S  UNIV"

typedef ('a,'c) discrete_market = "{(s::('c set), a::'c  (nat  'a  real)). stk_strict_subs s}" unfolding stk_strict_subs_def by fastforce

definition prices where
  "prices Mkt = (snd (Rep_discrete_market Mkt))"

definition assets where

  "assets Mkt = UNIV"


definition stocks where
  "stocks Mkt = (fst (Rep_discrete_market Mkt))"

definition discrete_market_of
where
  "discrete_market_of S A =
    Abs_discrete_market (if (stk_strict_subs S) then S else {}, A)"

lemma prices_of:
  shows "prices (discrete_market_of S A) = A"
proof -
  have "stk_strict_subs (if (stk_strict_subs S) then S else {})"
  proof (cases "stk_strict_subs S")
    case True thus ?thesis by simp
  next
    case False thus ?thesis unfolding stk_strict_subs_def by simp
  qed
  hence fct: "((if (stk_strict_subs S) then S else {}), A)  {(s, a). stk_strict_subs s}" by simp
  have "discrete_market_of S A = Abs_discrete_market (if (stk_strict_subs S) then S else {}, A)" unfolding discrete_market_of_def by simp
  hence "Rep_discrete_market (discrete_market_of S A) = (if (stk_strict_subs S) then S else {},A)"
    using Abs_discrete_market_inverse[of "(if (stk_strict_subs S) then S else {}, A)"] fct  by simp
  thus ?thesis unfolding prices_def by simp
qed

lemma stocks_of:
  assumes "UNIV  S"
  shows "stocks (discrete_market_of S A) = S"
proof -
  have "stk_strict_subs S" using assms unfolding stk_strict_subs_def by simp
  hence fct: "((if (stk_strict_subs S) then S else {}), A)  {(s, a). stk_strict_subs s}" by simp
  have "discrete_market_of S A = Abs_discrete_market (if (stk_strict_subs S) then S else {}, A)" unfolding discrete_market_of_def by simp
  hence "Rep_discrete_market (discrete_market_of S A) = (if (stk_strict_subs S) then S else {},A)"
    using Abs_discrete_market_inverse[of "(if (stk_strict_subs S) then S else {}, A)"] fct  by simp
  thus ?thesis unfolding stocks_def using ‹stk_strict_subs S by simp
qed

lemma mkt_stocks_assets:
  shows "stk_strict_subs (stocks Mkt)" unfolding stocks_def prices_def
  by (metis Rep_discrete_market mem_Collect_eq split_beta')

subsubsection ‹Quantity processes and portfolios›
text ‹These are functions that assign quantities to assets; each quantity is a stochastic process. Basic
operations are defined on these processes.›

paragraph ‹Basic operations›

definition qty_empty where
  "qty_empty = (λ (x::'a) (n::nat) w. 0::real)"

definition qty_single where
  "qty_single asset qt_proc = (qty_empty(asset := qt_proc))"

definition qty_sum::"('b  nat  'a  real)  ('b  nat  'a  real)  ('b  nat  'a  real)"  where
  "qty_sum pf1 pf2 = (λx n w. pf1 x n w + pf2 x n w)"

definition qty_mult_comp::"('b  nat  'a  real)  (nat  'a  real)  ('b  nat  'a  real)"  where
  "qty_mult_comp pf1 qty = (λx n w. (pf1 x n w) * (qty n w))"

definition qty_rem_comp::"('b  nat  'a  real)  'b  ('b  nat  'a  real)"  where
  "qty_rem_comp pf1 x = pf1(x:=(λn w. 0))"

definition qty_replace_comp where
  "qty_replace_comp pf1 x pf2 = qty_sum (qty_rem_comp pf1 x) (qty_mult_comp pf2 (pf1 x))"


paragraph ‹Support sets›

text ‹If p x n w is different from 0, this means that this quantity is held on interval ]n-1, n].›
definition support_set::"('b  nat  'a  real)  'b set" where
  "support_set p = {x.  n w. p x n w  0}"

lemma qty_empty_support_set:
  shows "support_set qty_empty = {}" unfolding support_set_def qty_empty_def by simp							
lemma sum_support_set:
  shows "support_set (qty_sum pf1 pf2)  (support_set pf1)  (support_set pf2)"
proof (intro subsetI, rule ccontr)
  fix x
  assume "x support_set (qty_sum pf1 pf2)" and "x  support_set pf1  support_set pf2" note xprops = this
  hence " n w. (qty_sum pf1 pf2) x n w  0" by (simp add: support_set_def)
  from this obtain n w where "(qty_sum pf1 pf2) x n w  0" by auto note nwprops = this
  have "pf1 x n w = 0" "pf2 x n w = 0" using xprops by (auto simp add:support_set_def)
  hence "(qty_sum pf1 pf2) x n w = 0" unfolding qty_sum_def by simp
  thus False using nwprops by simp
qed

lemma mult_comp_support_set:
shows "support_set (qty_mult_comp pf1 qty)  (support_set pf1)"
proof (intro subsetI, rule ccontr)
  fix x
  assume "x support_set (qty_mult_comp pf1 qty)" and "x  support_set pf1" note xprops = this
  hence " n w. (qty_mult_comp pf1 qty) x n w  0" by (simp add: support_set_def)
  from this obtain n w where "qty_mult_comp pf1 qty x n w  0" by auto note nwprops = this
  have "pf1 x n w = 0" using xprops by (simp add:support_set_def)
  hence "(qty_mult_comp pf1 qty) x n w = 0" unfolding qty_mult_comp_def by simp
  thus False using nwprops by simp
qed

lemma remove_comp_support_set:
shows "support_set (qty_rem_comp pf1 x)  ((support_set pf1) - {x})"
proof (intro subsetI, rule ccontr)
  fix y
  assume "y support_set (qty_rem_comp pf1 x)" and "y  support_set pf1 - {x}" note xprops = this
  hence "y support_set pf1  y = x" by simp
  have " n w. (qty_rem_comp pf1 x) y n w  0" using xprops by (simp add: support_set_def)
  from this obtain n w where "(qty_rem_comp pf1 x) y n w  0" by auto note nwprops = this
  show False
  proof (cases "y support_set pf1")
    case True
    hence "pf1 y n w = 0" using xprops by (simp add:support_set_def)
    hence "(qty_rem_comp pf1 x) x n w = 0" unfolding qty_rem_comp_def by simp
    thus ?thesis using nwprops by (metis pf1 y n w = 0 fun_upd_apply qty_rem_comp_def)
  next
    case False
    hence "y = x" using y support_set pf1  y = x by simp
    hence "(qty_rem_comp pf1 x) x n w = 0" unfolding qty_rem_comp_def by simp
    thus ?thesis using nwprops by (simp add: y = x)
  qed
qed

lemma replace_comp_support_set:
  shows "support_set (qty_replace_comp pf1 x pf2)  (support_set pf1 - {x})  support_set pf2"
proof -
  have "support_set (qty_replace_comp pf1 x pf2)  support_set (qty_rem_comp pf1 x)  support_set (qty_mult_comp pf2 (pf1 x))"
    unfolding qty_replace_comp_def by (simp add:sum_support_set)
  also have "...  (support_set pf1 - {x})  support_set pf2" using remove_comp_support_set mult_comp_support_set
    by (metis sup.mono)
  finally show ?thesis .
qed

lemma single_comp_support:
  shows "support_set (qty_single asset qty)  {asset}"
proof
  fix x
  assume "x support_set (qty_single asset qty)"
  show "x {asset}"
  proof (rule ccontr)
    assume "x {asset}"
    hence "x asset" by auto
    have " n w. qty_single asset qty x n w  0" using x support_set (qty_single asset qty)
      by (simp add:support_set_def)
    from this obtain n w where "qty_single asset qty x n w  0" by auto
    thus False using xasset by (simp add: qty_single_def qty_empty_def)
  qed
qed

lemma single_comp_nz_support:
  assumes " n w. qty n w 0"
  shows "support_set (qty_single asset qty) = {asset}"
proof
  show "support_set (qty_single asset qty)  {asset}" by (simp add: single_comp_support)
  have "asset support_set (qty_single asset qty)" using assms unfolding support_set_def qty_single_def by simp
  thus "{asset}  support_set (qty_single asset qty)" by auto
qed

paragraph ‹Portfolios›

definition portfolio where
  "portfolio p  finite (support_set p)"




definition stock_portfolio :: "('a, 'b) discrete_market  ('b  nat  'a  real)  bool" where
  "stock_portfolio Mkt p  portfolio p  support_set p  stocks Mkt"

lemma sum_portfolio:
  assumes "portfolio pf1"
  and "portfolio pf2"
shows "portfolio (qty_sum pf1 pf2)" unfolding portfolio_def
proof -
  have "support_set (qty_sum pf1 pf2)  (support_set pf1)  (support_set pf2)"  by (simp add: sum_support_set)
  thus "finite (support_set (qty_sum pf1 pf2))" using assms unfolding portfolio_def using infinite_super by auto
qed

lemma sum_basic_support_set:
  assumes "stock_portfolio Mkt pf1"
  and "stock_portfolio Mkt pf2"
shows "stock_portfolio Mkt (qty_sum pf1 pf2)" using assms sum_support_set[of pf1 pf2] unfolding stock_portfolio_def
  by (metis Diff_subset_conv gfp.leq_trans subset_Un_eq sum_portfolio)

lemma mult_comp_portfolio:
  assumes "portfolio pf1"
shows "portfolio (qty_mult_comp pf1 qty)" unfolding portfolio_def
proof -
  have "support_set (qty_mult_comp pf1 qty)  (support_set pf1)"  by (simp add: mult_comp_support_set)
  thus "finite (support_set (qty_mult_comp pf1 qty))" using assms unfolding portfolio_def using infinite_super by auto
qed

lemma mult_comp_basic_support_set:
  assumes "stock_portfolio Mkt pf1"
shows "stock_portfolio Mkt (qty_mult_comp pf1 qty)" using assms mult_comp_support_set[of pf1] unfolding stock_portfolio_def
  using mult_comp_portfolio by blast



lemma remove_comp_portfolio:
  assumes "portfolio pf1"
shows "portfolio (qty_rem_comp pf1 x)" unfolding portfolio_def
proof -
  have "support_set (qty_rem_comp pf1 x)  (support_set pf1)" using remove_comp_support_set[of pf1 x] by blast
  thus "finite (support_set (qty_rem_comp pf1 x))" using assms unfolding portfolio_def using infinite_super by auto
qed

lemma remove_comp_basic_support_set:
  assumes "stock_portfolio Mkt pf1"
shows "stock_portfolio Mkt (qty_mult_comp pf1 qty)" using assms mult_comp_support_set[of pf1] unfolding stock_portfolio_def
  using mult_comp_portfolio by blast

lemma replace_comp_portfolio:
  assumes "portfolio pf1"
  and "portfolio pf2"
shows "portfolio (qty_replace_comp pf1 x pf2)" unfolding portfolio_def
proof -
  have "support_set (qty_replace_comp pf1 x pf2)  (support_set pf1)  (support_set pf2)" using replace_comp_support_set[of pf1 x pf2] by blast
  thus "finite (support_set (qty_replace_comp pf1 x pf2))" using assms unfolding portfolio_def using infinite_super by auto
qed

lemma replace_comp_stocks:
  assumes "support_set pf1  stocks Mkt  {x}"
  and "support_set pf2  stocks Mkt"
shows "support_set (qty_replace_comp pf1 x pf2)  stocks Mkt"
proof -
  have "support_set (qty_rem_comp pf1 x)  stocks Mkt" using assms(1) remove_comp_support_set by fastforce
  moreover have "support_set (qty_mult_comp pf2 (pf1 x))  stocks Mkt" using assms mult_comp_support_set by fastforce
  ultimately show ?thesis unfolding qty_replace_comp_def using sum_support_set by fastforce
qed



lemma single_comp_portfolio:
  shows "portfolio (qty_single asset qty)"
  by (meson finite.emptyI finite.insertI finite_subset portfolio_def single_comp_support)

paragraph ‹Value processes›

definition val_process where
  "val_process Mkt p = (if (¬ (portfolio p)) then (λ n w. 0)
    else (λ n w . (sum (λx. ((prices Mkt) x n w) * (p x (Suc n) w)) (support_set p))))"



lemma subset_val_process':
  assumes "finite A"
  and "support_set p  A"
shows "val_process Mkt p n w = (sum (λx. ((prices Mkt) x n w) * (p x (Suc n) w)) A)"
proof -
  have "portfolio p" using assms unfolding portfolio_def using finite_subset by auto
  have "C. (support_set p)  C = {}  (support_set p)  C = A" using assms(2) by auto
  from this obtain C where "(support_set p)  C = {}" and "(support_set p)  C = A" by auto note Cprops = this
  have "finite C" using assms (support_set p)  C = A by auto
  have "x C. p x (Suc n) w = 0" using Cprops(1) support_set_def by fastforce
  hence "(x C. ((prices Mkt) x n w) * (p x (Suc n) w)) = 0" by simp
  hence "val_process Mkt p n w = (x (support_set p). ((prices Mkt) x n w) * (p x (Suc n) w))
    + (x C. ((prices Mkt) x n w) * (p x (Suc n) w))" unfolding val_process_def using ‹portfolio p by simp
  also have "... = ( x A. ((prices Mkt) x n w) * (p x (Suc n) w))"
    using ‹portfolio p ‹finite C Cprops portfolio_def sum_union_disjoint' by (metis (no_types, lifting))
  finally show "val_process Mkt p n w = ( x A. ((prices Mkt) x n w) * (p x (Suc n) w))" .
qed


lemma sum_val_process:
  assumes "portfolio pf1"
  and "portfolio pf2"
shows "n w. val_process Mkt (qty_sum pf1 pf2) n w = (val_process Mkt pf1) n w + (val_process Mkt pf2) n w"
proof (intro allI)
  fix n w
  have vp1: "val_process Mkt pf1 n w = ( x (support_set pf1) (support_set pf2). ((prices Mkt) x n w) * (pf1 x (Suc n) w))"
  proof -
    have "finite (support_set pf1  support_set pf2)  support_set pf1  support_set pf1  support_set pf2"
      by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
    then show ?thesis
      by (simp add: subset_val_process')
  qed
  have vp2: "val_process Mkt pf2 n w = ( x (support_set pf1) (support_set pf2). ((prices Mkt) x n w) * (pf2 x (Suc n) w))"
  proof -
    have "finite (support_set pf1  support_set pf2)  support_set pf2  support_set pf2  support_set pf1"
      by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
    then show ?thesis
      by (simp add: subset_val_process')
  qed
  have pf:"portfolio (qty_sum pf1 pf2)" using assms by (simp add:sum_portfolio)
  have fin:"finite (support_set pf1  support_set pf2)" using assms finite_Un unfolding portfolio_def by auto
  have "(val_process Mkt pf1) n w + (val_process Mkt pf2) n w =
    ( x (support_set pf1) (support_set pf2). ((prices Mkt) x n w) * (pf1 x (Suc n) w)) +
    ( x (support_set pf1) (support_set pf2). ((prices Mkt) x n w) * (pf2 x (Suc n) w))"
    using vp1 vp2 by simp
  also have "... = ( x (support_set pf1) (support_set pf2).
    (((prices Mkt) x n w) * (pf1 x (Suc n) w)) + ((prices Mkt) x n w) * (pf2 x (Suc n) w))"
    by (simp add: sum.distrib)
  also have "... = ( x (support_set pf1) (support_set pf2).
    ((prices Mkt) x n w) * ((pf1 x (Suc n) w) + (pf2 x (Suc n) w)))" by (simp add: distrib_left)
  also have "... = ( x (support_set pf1) (support_set pf2).
    ((prices Mkt) x n w) * ((qty_sum pf1 pf2) x (Suc n) w))" by (simp add: qty_sum_def)
  also have "... = ( x (support_set (qty_sum pf1 pf2)).
    ((prices Mkt) x n w) * ((qty_sum pf1 pf2) x (Suc n) w))" using sum_support_set[of pf1 pf2]
    subset_val_process'[of "support_set pf1 support_set pf2" "qty_sum pf1 pf2"] pf fin unfolding val_process_def by simp
  also have "... = val_process Mkt (qty_sum pf1 pf2) n w" by (metis (no_types, lifting) pf sum.cong val_process_def)
  finally have "(val_process Mkt pf1) n w + (val_process Mkt pf2) n w = val_process Mkt (qty_sum pf1 pf2) n w" .
  thus "val_process Mkt (qty_sum pf1 pf2) n w = (val_process Mkt pf1) n w + (val_process Mkt pf2) n w" ..
qed


lemma mult_comp_val_process:
  assumes "portfolio pf1"
shows "n w. val_process Mkt (qty_mult_comp pf1 qty) n w = ((val_process Mkt pf1) n w) * (qty (Suc n) w)"
proof (intro allI)
  fix n w
  have pf:"portfolio (qty_mult_comp pf1 qty)" using assms by (simp add:mult_comp_portfolio)
  have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
  have "((val_process Mkt pf1) n w) * (qty (Suc n) w) =
    ( x (support_set pf1). ((prices Mkt) x n w) * (pf1 x (Suc n) w))*(qty (Suc n) w)"
    unfolding val_process_def using assms by simp
  also have "... = ( x (support_set pf1).
    (((prices Mkt) x n w) * (pf1 x (Suc n) w) * (qty (Suc n) w)))" using sum_distrib_right by auto
  also have "... = ( x (support_set pf1).
    ((prices Mkt) x n w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" unfolding qty_mult_comp_def
    by (simp add: mult.commute mult.left_commute)
  also have "... = ( x (support_set (qty_mult_comp pf1 qty)).
    ((prices Mkt) x n w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" using mult_comp_support_set[of pf1]
    subset_val_process'[of "support_set pf1" "qty_mult_comp pf1 qty"] pf fin unfolding val_process_def by simp
  also have "... = val_process Mkt (qty_mult_comp pf1 qty) n w" by (metis (no_types, lifting) pf sum.cong val_process_def)
  finally have "(val_process Mkt pf1) n w * (qty (Suc n) w) = val_process Mkt (qty_mult_comp pf1 qty) n w" .
  thus "val_process Mkt (qty_mult_comp pf1 qty) n w = (val_process Mkt pf1) n w * (qty (Suc n) w)" ..
qed





lemma remove_comp_values:
  assumes "x  y"
  shows "n w. pf1 x n w = (qty_rem_comp pf1 y) x n w"
proof (intro allI)
  fix n w
  show "pf1 x n w = (qty_rem_comp pf1 y) x n w" by (simp add: assms qty_rem_comp_def)
qed




lemma remove_comp_val_process:
  assumes "portfolio pf1"
shows "n w. val_process Mkt (qty_rem_comp pf1 y) n w = ((val_process Mkt pf1) n w) - (prices Mkt y n w)* (pf1 y (Suc n) w)"
proof (intro allI)
  fix n w
  have pf:"portfolio (qty_rem_comp pf1 y)" using assms by (simp add:remove_comp_portfolio)
  have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
  hence fin2: "finite (support_set pf1 - {y})" by simp
  have "((val_process Mkt pf1) n w)  =
    ( x (support_set pf1). ((prices Mkt) x n w) * (pf1 x (Suc n) w))"
    unfolding val_process_def using assms by simp
  also have "... = ( x (support_set pf1 - {y}).
    (((prices Mkt) x n w) * (pf1 x (Suc n) w))) + (prices Mkt y n w)* (pf1 y (Suc n) w)"
  proof (cases "y support_set pf1")
    case True
    thus ?thesis by (simp add: fin sum_diff1)
  next
    case False
    hence "pf1 y (Suc n) w = 0" unfolding support_set_def by simp
    thus ?thesis by (simp add: fin sum_diff1)
  qed
  also have "... = ( x (support_set pf1 - {y}).
    ((prices Mkt) x n w) * ((qty_rem_comp pf1 y) x (Suc n) w)) + (prices Mkt y n w)* (pf1 y (Suc n) w)"
  proof -
    have "( x (support_set pf1 - {y}). (((prices Mkt) x n w) * (pf1 x (Suc n) w))) =
      ( x (support_set pf1 - {y}). ((prices Mkt) x n w) * ((qty_rem_comp pf1 y) x (Suc n) w))"
    proof (rule sum.cong,simp)
      fix x
      assume "x support_set pf1 - {y}"
      show "prices Mkt x n w * pf1 x (Suc n) w = prices Mkt x n w * qty_rem_comp pf1 y x (Suc n) w" using remove_comp_values
        by (metis DiffD2 x  support_set pf1 - {y} singletonI)
    qed
    thus ?thesis by simp
  qed
  also have "... = (val_process Mkt (qty_rem_comp pf1 y) n w) + (prices Mkt y n w)* (pf1 y (Suc n) w)"
    using subset_val_process'[of "support_set pf1 - {y}" "qty_rem_comp pf1 y"] fin2
    by (simp add: remove_comp_support_set)
  finally have "(val_process Mkt pf1) n w =
    (val_process Mkt (qty_rem_comp pf1 y) n w) + (prices Mkt y n w)* (pf1 y (Suc n) w)" .
  thus  "val_process Mkt (qty_rem_comp pf1 y) n w = ((val_process Mkt pf1) n w) - (prices Mkt y n w)* (pf1 y (Suc n) w)" by simp
qed




lemma replace_comp_val_process:
  assumes "n w. prices Mkt x n w = val_process Mkt pf2 n w"
  and "portfolio pf1"
  and "portfolio pf2"
  shows "n w. val_process Mkt (qty_replace_comp pf1 x pf2) n w = val_process Mkt pf1 n w"
proof (intro allI)
  fix n w
  have "val_process Mkt (qty_replace_comp pf1 x pf2) n w = val_process Mkt (qty_rem_comp pf1 x) n w +
    val_process Mkt (qty_mult_comp pf2 (pf1 x)) n w" unfolding qty_replace_comp_def using assms
    sum_val_process[of "qty_rem_comp pf1 x" "qty_mult_comp pf2 (pf1 x)"]
    by (simp add: mult_comp_portfolio remove_comp_portfolio)
  also have "... = val_process Mkt pf1 n w - (prices Mkt x n w * pf1 x (Suc n) w) + val_process Mkt pf2 n w * pf1 x (Suc n) w"
    by (simp add: assms(2) assms(3) mult_comp_val_process remove_comp_val_process)
  also have "... = val_process Mkt pf1 n w" using assms by simp
  finally show "val_process Mkt (qty_replace_comp pf1 x pf2) n w = val_process Mkt pf1 n w" .
qed

lemma qty_single_val_process:
shows "val_process Mkt (qty_single asset qty) n w =
    prices Mkt asset n w * qty (Suc n) w"
proof -
  have "val_process Mkt (qty_single asset qty) n w =
    (sum (λx. ((prices Mkt) x n w) * ((qty_single asset qty) x (Suc n) w)) {asset})"
  proof (rule subset_val_process')
    show "finite {asset}" by simp
    show "support_set (qty_single asset qty)  {asset}" by (simp add: single_comp_support)
  qed
  also have "... = prices Mkt asset n w * qty (Suc n) w" unfolding qty_single_def by simp
  finally show ?thesis .
qed



subsubsection ‹Trading strategies›





locale disc_equity_market = triv_init_disc_filtr_prob_space +
  fixes Mkt::"('a,'b) discrete_market"


paragraph ‹Discrete predictable processes›



paragraph ‹Trading strategy›

definition (in disc_filtr_prob_space) trading_strategy
where
  "trading_strategy p  portfolio p  (asset  support_set p. borel_predict_stoch_proc F (p asset))"

definition (in disc_filtr_prob_space) support_adapt:: "('a, 'b) discrete_market  ('b  nat  'a  real)  bool" where
  "support_adapt Mkt pf  ( asset  support_set pf. borel_adapt_stoch_proc F (prices Mkt asset))"

lemma (in disc_filtr_prob_space) quantity_adapted:
  assumes " asset  support_set p. p asset (Suc n)  borel_measurable (F n)"
  "asset  support_set p. prices Mkt asset n  borel_measurable (F n)"
shows "val_process Mkt p n  borel_measurable (F n)"
proof (cases "portfolio p")
case False
  have "val_process Mkt p = (λ n w. 0)" unfolding val_process_def using False by simp
  thus "?thesis" by simp
next
  case True
  hence "val_process Mkt p n = (λw. xsupport_set p. prices Mkt x n w * p x (Suc n) w)"
    unfolding val_process_def using True by simp
  moreover have "(λw. xsupport_set p. prices Mkt x n w * p x (Suc n) w)  borel_measurable (F n)"
  proof (rule borel_measurable_sum)
    fix asset
    assume "asset support_set p"
    hence "p asset (Suc n)  borel_measurable (F n)" using assms unfolding trading_strategy_def adapt_stoch_proc_def by simp
    moreover have "prices Mkt asset n  borel_measurable (F n)"
      using asset  support_set p  assms(2) unfolding support_adapt_def by (simp add: adapt_stoch_proc_def)
    ultimately show "(λx. prices Mkt asset n x * p asset (Suc n) x)  borel_measurable (F n)" by simp
  qed
  ultimately show "val_process Mkt p n  borel_measurable (F n)" by simp
qed



lemma (in disc_filtr_prob_space) trading_strategy_adapted:
  assumes "trading_strategy p"
  and "support_adapt Mkt p"
  shows "borel_adapt_stoch_proc F (val_process Mkt p)" unfolding support_adapt_def
proof (cases "portfolio p")
case False
  have "val_process Mkt p = (λ n w. 0)" unfolding val_process_def using False by simp
  thus "borel_adapt_stoch_proc F (val_process Mkt p)"
    by (simp add: constant_process_borel_adapted)
next
case True
  show ?thesis unfolding adapt_stoch_proc_def
  proof
    fix n
    have "val_process Mkt p n = (λw. xsupport_set p. prices Mkt x n w * p x (Suc n) w)"
      unfolding val_process_def using True by simp
    moreover have "(λw. xsupport_set p. prices Mkt x n w * p x (Suc n) w)  borel_measurable (F n)"
    proof (rule borel_measurable_sum)
      fix asset
      assume "asset support_set p"
      hence "p asset (Suc n)  borel_measurable (F n)" using assms unfolding trading_strategy_def predict_stoch_proc_def by simp
      moreover have "prices Mkt asset n  borel_measurable (F n)"
        using asset  support_set p  assms(2) unfolding support_adapt_def  by (simp add:adapt_stoch_proc_def)
      ultimately show "(λx. prices Mkt asset n x * p asset (Suc n) x)  borel_measurable (F n)" by simp
    qed
    ultimately show "val_process Mkt p n  borel_measurable (F n)" by simp
  qed
qed




lemma (in disc_equity_market) ats_val_process_adapted:
  assumes "trading_strategy p"
and "support_adapt Mkt p"
  shows "borel_adapt_stoch_proc F (val_process Mkt p)" unfolding support_adapt_def
  by (meson assms(1) assms(2)  subsetCE trading_strategy_adapted)



lemma (in disc_equity_market) trading_strategy_init:
  assumes "trading_strategy p"
and "support_adapt Mkt p"
  shows "c. w  space M. val_process Mkt p 0 w = c" using assms adapted_init ats_val_process_adapted by simp


definition (in disc_equity_market) initial_value where
  "initial_value pf = constant_image (val_process Mkt pf 0)"

lemma (in disc_equity_market) initial_valueI:
  assumes "trading_strategy pf"
and "support_adapt Mkt pf"
  shows "w space M. val_process Mkt pf 0 w = initial_value pf" unfolding initial_value_def
proof (rule constant_imageI)
  show "c. wspace M. val_process Mkt pf 0 w = c" using trading_strategy_init assms by simp
qed


lemma (in disc_equity_market) inc_predict_support_trading_strat:
  assumes "trading_strategy pf1"
  shows " asset  support_set pf1  B. borel_predict_stoch_proc F (pf1 asset)"
proof
  fix asset
  assume "asset  support_set pf1  B"
  show "borel_predict_stoch_proc F (pf1 asset)"
  proof (cases "asset  support_set pf1")
    case True
    thus ?thesis using assms unfolding trading_strategy_def by simp
  next
    case False
    hence "n w. pf1 asset n w = 0" unfolding support_set_def by simp
    show ?thesis unfolding predict_stoch_proc_def
    proof
      show "pf1 asset 0  measurable (F 0) borel" using n w. pf1 asset n w = 0
        by (simp add: borel_measurable_const measurable_cong)
    next
      show "n. pf1 asset (Suc n)  borel_measurable (F n)"
      proof
        fix n
        have "w. pf1 asset (Suc n) w = 0" using n w. pf1 asset n w = 0 by simp
        have "0 space borel" by simp
        thus "pf1 asset (Suc n)  measurable (F n) borel" using measurable_const[of 0 borel "F n"]
          by (metis 0  space borel  (λx. 0)  borel_measurable (F n) 0  space borel›
              n w. pf1 asset n w = 0 measurable_cong)
      qed
    qed
  qed
qed

lemma (in disc_equity_market) inc_predict_support_trading_strat':
  assumes "trading_strategy pf1"
  and "asset  support_set pf1 B"
  shows "borel_predict_stoch_proc F (pf1 asset)"
proof (cases "asset  support_set pf1")
  case True
  thus ?thesis using assms unfolding trading_strategy_def by simp
next
  case False
  hence "n w. pf1 asset n w = 0" unfolding support_set_def by simp
  show ?thesis unfolding predict_stoch_proc_def
  proof
    show "pf1 asset 0  measurable (F 0) borel" using n w. pf1 asset n w = 0
      by (simp add: borel_measurable_const measurable_cong)
  next
    show "n. pf1 asset (Suc n)  borel_measurable (F n)"
    proof
      fix n
      have "w. pf1 asset (Suc n) w = 0" using n w. pf1 asset n w = 0 by simp
      have "0 space borel" by simp
      thus "pf1 asset (Suc n)  measurable (F n) borel" using measurable_const[of 0 borel "F n"]
        by (metis 0  space borel  (λx. 0)  borel_measurable (F n) 0  space borel›
            n w. pf1 asset n w = 0 measurable_cong)
    qed
  qed
qed



lemma (in disc_equity_market) inc_support_trading_strat:
  assumes "trading_strategy pf1"
  shows " asset  support_set pf1  B. borel_adapt_stoch_proc F (pf1 asset)" using assms
  by (simp add: inc_predict_support_trading_strat predict_imp_adapt)

lemma (in disc_equity_market) qty_empty_trading_strat:
  shows "trading_strategy qty_empty" unfolding trading_strategy_def 
proof (intro conjI ballI)
  show "portfolio qty_empty"
    by (metis fun_upd_triv qty_single_def single_comp_portfolio) 
  show "asset. asset  support_set qty_empty  borel_predict_stoch_proc F (qty_empty asset)"
    using qty_empty_support_set by auto
qed													  

lemma (in disc_equity_market) sum_trading_strat:
  assumes "trading_strategy pf1"
  and "trading_strategy pf2"
shows "trading_strategy (qty_sum pf1 pf2)"
proof -
  have " asset  support_set pf1  support_set pf2. borel_predict_stoch_proc F (pf1 asset)"
    using assms by (simp add: inc_predict_support_trading_strat)
  have " asset  support_set pf2  support_set pf1. borel_predict_stoch_proc F (pf2 asset)"
    using assms by (simp add: inc_predict_support_trading_strat)
  have " asset  support_set pf1  support_set pf2. borel_predict_stoch_proc F ((qty_sum pf1 pf2) asset)"
  proof
    fix asset
    assume "asset  support_set pf1  support_set pf2"
    show "borel_predict_stoch_proc F (qty_sum pf1 pf2 asset)" unfolding predict_stoch_proc_def qty_sum_def
    proof
      show "(λw. pf1 asset 0 w + pf2 asset 0 w)  borel_measurable (F 0)"
      proof -
        have "(λw. pf1 asset 0 w)  borel_measurable (F 0)"
        using assetsupport_set pf1  support_set pf2. borel_predict_stoch_proc F (pf1 asset)
        asset  support_set pf1  support_set pf2 predict_stoch_proc_def by blast
        moreover have "(λw. pf2 asset 0 w)  borel_measurable (F 0)"
          using assetsupport_set pf2  support_set pf1. borel_predict_stoch_proc F (pf2 asset)
          asset  support_set pf1  support_set pf2 predict_stoch_proc_def by blast
        ultimately show ?thesis by simp
      qed
    next
      show "n. (λw. pf1 asset (Suc n) w + pf2 asset (Suc n) w)  borel_measurable (F n)"
      proof
        fix n
        have "(λw. pf1 asset (Suc n) w)  borel_measurable (F n)"
          using assetsupport_set pf1  support_set pf2. borel_predict_stoch_proc F (pf1 asset)
          asset  support_set pf1  support_set pf2 predict_stoch_proc_def by blast
        moreover have "(λw. pf2 asset (Suc n) w)  borel_measurable (F n)"
          using assetsupport_set pf2  support_set pf1. borel_predict_stoch_proc F (pf2 asset)
          asset  support_set pf1  support_set pf2 predict_stoch_proc_def by blast
        ultimately show "(λw. pf1 asset (Suc n) w + pf2 asset (Suc n) w)  borel_measurable (F n)" by simp
      qed
    qed
  qed
  thus ?thesis unfolding trading_strategy_def using sum_support_set[of pf1 pf2]
    by (meson assms(1) assms(2) subsetCE sum_portfolio trading_strategy_def)
qed

lemma (in disc_equity_market) mult_comp_trading_strat:
  assumes "trading_strategy pf1"
  and "borel_predict_stoch_proc F qty"
shows "trading_strategy (qty_mult_comp pf1 qty)"
proof -
  have " asset  support_set pf1. borel_predict_stoch_proc F (pf1 asset)"
    using assms unfolding trading_strategy_def by simp
  have " asset  support_set pf1. borel_predict_stoch_proc F (qty_mult_comp pf1 qty asset)"
    unfolding predict_stoch_proc_def qty_mult_comp_def
  proof (intro ballI conjI)
    fix asset
    assume "asset  support_set pf1"
    show "(λw. pf1 asset 0 w * qty 0 w)  borel_measurable (F 0)"
    proof -
      have "(λw. pf1 asset 0 w)  borel_measurable (F 0)"
        using assetsupport_set pf1. borel_predict_stoch_proc F (pf1 asset)
        asset  support_set pf1 predict_stoch_proc_def by auto
      moreover have "(λw. qty 0 w)  borel_measurable (F 0)" using assms predict_stoch_proc_def by auto
      ultimately show "(λw. pf1 asset 0 w * qty 0 w)  borel_measurable (F 0)" by simp
    qed
    show "n. (λw. pf1 asset (Suc n) w * qty (Suc n) w)  borel_measurable (F n)"
    proof
      fix n
      have "(λw. pf1 asset (Suc n) w)  borel_measurable (F n)"
        using assetsupport_set pf1. borel_predict_stoch_proc F (pf1 asset)
        asset  support_set pf1 predict_stoch_proc_def by blast
      moreover have "(λw. qty (Suc n) w)  borel_measurable (F n)" using assms predict_stoch_proc_def by blast
      ultimately show "(λw. pf1 asset (Suc n) w * qty (Suc n) w)  borel_measurable (F n)" by simp
    qed
  qed
  thus ?thesis unfolding trading_strategy_def using mult_comp_support_set[of pf1 qty]
    by (meson assms(1) mult_comp_portfolio subsetCE trading_strategy_def)
qed

lemma (in disc_equity_market) remove_comp_trading_strat:
  assumes "trading_strategy pf1"
shows "trading_strategy (qty_rem_comp pf1 x)"
proof -
  have " asset  support_set pf1. borel_predict_stoch_proc F (pf1 asset)"
    using assms unfolding trading_strategy_def by simp
  have " asset  support_set pf1. borel_predict_stoch_proc F (qty_rem_comp pf1 x asset)"
    unfolding predict_stoch_proc_def qty_rem_comp_def
  proof (intro ballI conjI)
    fix asset
    assume "asset  support_set pf1"
    show "(pf1(x := λn w. 0)) asset 0  borel_measurable (F 0)"
    proof -
      show "(λw. (pf1(x := λn w. 0)) asset 0 w)  borel_measurable (F 0)"
      proof (cases "asset = x")
        case True
        thus ?thesis by simp
      next
        case False
        thus "(λw. (pf1(x := λn w. 0)) asset 0 w)  borel_measurable (F 0)"
          using assetsupport_set pf1. borel_predict_stoch_proc F (pf1 asset)
          asset  support_set pf1 by (simp add: predict_stoch_proc_def)
      qed
    qed
    show "n. (λw. (pf1(x := λn w. 0)) asset (Suc n) w)  borel_measurable (F n)"
    proof
      fix n
      show "(λw. (pf1(x := λn w. 0)) asset (Suc n) w)  borel_measurable (F n)"
      proof (cases "asset = x")
        case True
        thus ?thesis by simp
      next
        case False
        thus "(λw. (pf1(x := λn w. 0)) asset (Suc n) w)  borel_measurable (F n)"
          using assetsupport_set pf1. borel_predict_stoch_proc F (pf1 asset)
          asset  support_set pf1 by (simp add: predict_stoch_proc_def)
      qed
    qed
  qed
  thus ?thesis unfolding trading_strategy_def using remove_comp_support_set[of pf1 x]
    by (metis Diff_empty assms remove_comp_portfolio subsetCE subset_Diff_insert trading_strategy_def)
qed


lemma (in disc_equity_market) replace_comp_trading_strat:
  assumes "trading_strategy pf1"
  and "trading_strategy pf2"
shows "trading_strategy (qty_replace_comp pf1 x pf2)" unfolding qty_replace_comp_def
proof (rule sum_trading_strat)
  show "trading_strategy (qty_rem_comp pf1 x)" using assms by (simp add: remove_comp_trading_strat)
  show "trading_strategy (qty_mult_comp pf2 (pf1 x))"
  proof (cases "x support_set pf1")
    case True
    hence "borel_predict_stoch_proc F (pf1 x)" using assms unfolding trading_strategy_def by simp
    thus ?thesis using assms by (simp add: mult_comp_trading_strat)
  next
    case False
    thus ?thesis
    proof -
      obtain nn :: "'c  ('c  nat  'a  real)  nat" and aa :: "'c  ('c  nat  'a  real)  'a" where
        "x0 x1. (v2 v3. x1 x0 v2 v3  0) = (x1 x0 (nn x0 x1) (aa x0 x1)  0)"
        by moura
      then have "f c. (c  {c. n a. f c n a  0}  f c (nn c f) (aa c f)  0)  (c  {c. n a. f c n a  0}  (n a. f c n a = 0))"
        by auto
      then show ?thesis
      proof -
        have "f c n a. qty_mult_comp f (pf1 x) (c::'c) n a = 0"
          by (metis False f c. (c  {c. n a. f c n a  0}  f c (nn c f) (aa c f)  0)  (c  {c. n a. f c n a  0}  (n a. f c n a = 0)) mult.commute mult_zero_left qty_mult_comp_def support_set_def)
        then show ?thesis
          by (metis (no_types) f c. (c  {c. n a. f c n a  0}  f c (nn c f) (aa c f)  0)  (c  {c. n a. f c n a  0}  (n a. f c n a = 0)) assms(2) mult_comp_portfolio support_set_def trading_strategy_def)
      qed
    qed
  qed
qed



subsubsection ‹Self-financing portfolios›

paragraph ‹Closing value process›

fun up_cl_proc where
  "up_cl_proc Mkt p 0 = val_process Mkt p 0" |
  "up_cl_proc Mkt p (Suc n) = (λw. xsupport_set p. prices Mkt x (Suc n) w * p x (Suc n) w)"


definition cls_val_process where
"cls_val_process Mkt p = (if (¬ (portfolio p)) then (λ n w. 0)
    else (λ n w . up_cl_proc Mkt p n w))"



lemma (in disc_filtr_prob_space) quantity_updated_borel:
  assumes "n.  asset  support_set p. p asset (Suc n)  borel_measurable (F n)"
and "n. asset  support_set p. prices Mkt asset n  borel_measurable (F n)"
shows "n. cls_val_process Mkt p n  borel_measurable (F n)"
proof (cases "portfolio p")
case False
  have "cls_val_process Mkt p = (λ n w. 0)" unfolding cls_val_process_def using False by simp
  thus "?thesis" by simp
next
  case True
  show "n. cls_val_process Mkt p n  borel_measurable (F n)"
  proof
    fix n
    show "cls_val_process Mkt p n  borel_measurable (F n)"
    proof (cases "n = 0")
      case False
      hence "m. n = Suc m" using old.nat.exhaust by auto
      from this obtain m where "n = Suc m" by auto
      have "cls_val_process Mkt p (Suc m) = (λw. xsupport_set p. prices Mkt x (Suc m) w * p x (Suc m) w)"
        unfolding cls_val_process_def using True by simp
      moreover have "(λw. xsupport_set p. prices Mkt x (Suc m) w * p x (Suc m) w)  borel_measurable (F (Suc m))"
      proof (rule borel_measurable_sum)
        fix asset
        assume "asset support_set p"
        hence "p asset (Suc m)  borel_measurable (F m)" using assms unfolding trading_strategy_def adapt_stoch_proc_def by simp
        hence "p asset (Suc m)  borel_measurable (F (Suc m))"
          using Suc_n_not_le_n increasing_measurable_info nat_le_linear by blast
        moreover have "prices Mkt asset (Suc m)  borel_measurable (F (Suc m))"
          using asset  support_set p  assms(2) unfolding support_adapt_def adapt_stoch_proc_def by blast
        ultimately show "(λx. prices Mkt asset (Suc m) x * p asset (Suc m) x)  borel_measurable (F (Suc m))" by simp
      qed
      ultimately have "cls_val_process Mkt p (Suc m)  borel_measurable (F (Suc m))" by simp
      thus ?thesis using n = Suc m by simp
    next
      case True
      thus "cls_val_process Mkt p n  borel_measurable (F n)"
        by (metis (no_types, lifting) assms(1) assms(2)  quantity_adapted up_cl_proc.simps(1)
            cls_val_process_def val_process_def)
    qed
  qed
qed


lemma (in disc_equity_market) cls_val_process_adapted:
  assumes "trading_strategy p"
and "support_adapt Mkt p"
  shows "borel_adapt_stoch_proc F (cls_val_process Mkt p)"
proof (cases "portfolio p")
  case False
    have "cls_val_process Mkt p = (λ n w. 0)" unfolding cls_val_process_def using False by simp
    thus "borel_adapt_stoch_proc F (cls_val_process Mkt p)"
      by (simp add: constant_process_borel_adapted)
next
  case True
  show ?thesis unfolding adapt_stoch_proc_def
  proof
    fix n
    show "cls_val_process Mkt p n  borel_measurable (F n)"
    proof (cases "n = 0")
    case True
      thus "cls_val_process Mkt p n  borel_measurable (F n)"
        using up_cl_proc.simps(1) assms
        by (metis (no_types, lifting) adapt_stoch_proc_def ats_val_process_adapted cls_val_process_def
            val_process_def)
    next
    case False
      hence "m. Suc m = n" using not0_implies_Suc by blast
      from this obtain m where "Suc m = n" by auto
      hence "cls_val_process Mkt p n = up_cl_proc Mkt p n" unfolding cls_val_process_def using True by simp
      also have "... = (λw. xsupport_set p. prices Mkt x n w * p x n w)"
        using up_cl_proc.simps(2) ‹Suc m = n by auto
      finally have "cls_val_process Mkt p n = (λw. xsupport_set p. prices Mkt x n w * p x n w)" .
    moreover have "(λw. xsupport_set p. prices Mkt x n w * p x n w)  borel_measurable (F n)"
    proof (rule borel_measurable_sum)
      fix asset
      assume "asset support_set p"
      hence "p asset n  borel_measurable (F n)" using assms unfolding trading_strategy_def predict_stoch_proc_def
        using Suc_n_not_le_n ‹Suc m = n increasing_measurable_info nat_le_linear by blast
      moreover have "prices Mkt asset n  borel_measurable (F n)" using  assms asset  support_set p unfolding support_adapt_def adapt_stoch_proc_def
        using stock_portfolio_def by blast
      ultimately show "(λx. prices Mkt asset n x * p asset n x)  borel_measurable (F n)" by simp
    qed
    ultimately show "cls_val_process Mkt p n  borel_measurable (F n)" by simp
    qed
  qed
qed

lemma subset_cls_val_process:
  assumes "finite A"
  and "support_set p  A"
shows "n w. cls_val_process Mkt p (Suc n) w = (sum (λx. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) A)"
proof (intro allI)
  fix n::nat
  fix w::'b
  have "portfolio p" using assms unfolding portfolio_def using finite_subset by auto
  have "C. (support_set p)  C = {}  (support_set p)  C = A" using assms(2) by auto
  from this obtain C where "(support_set p)  C = {}" and "(support_set p)  C = A" by auto note Cprops = this
  have "finite C" using assms (support_set p)  C = A by auto
  have "x C. p x (Suc n) w = 0" using Cprops(1) support_set_def by fastforce
  hence "(x C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) = 0" by simp
  hence "cls_val_process Mkt p (Suc n) w = (x (support_set p). ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))
    + (x C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" unfolding cls_val_process_def
    using ‹portfolio p up_cl_proc.simps(2)[of Mkt p n] by simp
  also have "... = ( x A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))"
    using ‹portfolio p ‹finite C Cprops portfolio_def sum_union_disjoint' by (metis (no_types, lifting))
  finally show "cls_val_process Mkt p (Suc n) w = ( x A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" .
qed

lemma subset_cls_val_process':
  assumes "finite A"
  and "support_set p  A"
shows "cls_val_process Mkt p (Suc n) w = (sum (λx. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) A)"
proof -
  have "portfolio p" using assms unfolding portfolio_def using finite_subset by auto
  have "C. (support_set p)  C = {}  (support_set p)  C = A" using assms(2) by auto
  from this obtain C where "(support_set p)  C = {}" and "(support_set p)  C = A" by auto note Cprops = this
  have "finite C" using assms (support_set p)  C = A by auto
  have "x C. p x (Suc n) w = 0" using Cprops(1) support_set_def by fastforce
  hence "(x C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w)) = 0" by simp
  hence "cls_val_process Mkt p (Suc n) w = (x (support_set p). ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))
    + (x C. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" unfolding cls_val_process_def
    using ‹portfolio p up_cl_proc.simps(2)[of Mkt p n] by simp
  also have "... = ( x A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))"
    using ‹portfolio p ‹finite C Cprops portfolio_def sum_union_disjoint' by (metis (no_types, lifting))
  finally show "cls_val_process Mkt p (Suc n) w = ( x A. ((prices Mkt) x (Suc n) w) * (p x (Suc n) w))" .
qed



lemma sum_cls_val_process_Suc:
  assumes "portfolio pf1"
  and "portfolio pf2"
shows "n w. cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
  (cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w"
proof (intro allI)
  fix n w
  have vp1: "cls_val_process Mkt pf1 (Suc n) w =
    ( x (support_set pf1) (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))"
  proof -
    have "finite (support_set pf1  support_set pf2)  support_set pf1  support_set pf1  support_set pf2"
      by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
    then show ?thesis
      by (simp add: subset_cls_val_process)
  qed
  have vp2: "cls_val_process Mkt pf2 (Suc n) w = ( x (support_set pf1) (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf2 x (Suc n) w))"
  proof -
    have "finite (support_set pf1  support_set pf2)  support_set pf2  support_set pf2  support_set pf1"
      by (meson assms(1) assms(2) finite_Un portfolio_def sup.cobounded1)
    then show ?thesis by (auto simp add: subset_cls_val_process)
  qed
  have pf:"portfolio (qty_sum pf1 pf2)" using assms by (simp add:sum_portfolio)
  have fin:"finite (support_set pf1  support_set pf2)" using assms finite_Un unfolding portfolio_def by auto
  have "(cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w =
    ( x (support_set pf1) (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w)) +
    ( x (support_set pf1) (support_set pf2). ((prices Mkt) x (Suc n) w) * (pf2 x (Suc n) w))"
    using vp1 vp2 by simp
  also have "... = ( x (support_set pf1) (support_set pf2).
    (((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w)) + ((prices Mkt) x (Suc n) w) * (pf2 x (Suc n) w))"
    by (simp add: sum.distrib)
  also have "... = ( x (support_set pf1) (support_set pf2).
    ((prices Mkt) x (Suc n) w) * ((pf1 x (Suc n) w) + (pf2 x (Suc n) w)))" by (simp add: distrib_left)
  also have "... = ( x (support_set pf1) (support_set pf2).
    ((prices Mkt) x (Suc n) w) * ((qty_sum pf1 pf2) x (Suc n) w))" by (simp add: qty_sum_def)
  also have "... = ( x (support_set (qty_sum pf1 pf2)).
    ((prices Mkt) x (Suc n) w) * ((qty_sum pf1 pf2) x (Suc n) w))" using sum_support_set[of pf1 pf2]
    subset_cls_val_process[of "support_set pf1 support_set pf2" "qty_sum pf1 pf2"] pf fin
    unfolding cls_val_process_def by simp
  also have "... = cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w"
    by (metis (no_types, lifting) pf sum.cong up_cl_proc.simps(2) cls_val_process_def)
  finally have "(cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w =
    cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w" .
  thus "cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
    (cls_val_process Mkt pf1) (Suc n) w + (cls_val_process Mkt pf2) (Suc n) w" ..
qed

lemma sum_cls_val_process0:
  assumes "portfolio pf1"
  and "portfolio pf2"
shows "w. cls_val_process Mkt (qty_sum pf1 pf2) 0 w =
  (cls_val_process Mkt pf1) 0 w + (cls_val_process Mkt pf2) 0 w" unfolding cls_val_process_def
  by (simp add: sum_val_process assms(1) assms(2) sum_portfolio)

lemma sum_cls_val_process:
  assumes "portfolio pf1"
  and "portfolio pf2"
shows "n w. cls_val_process Mkt (qty_sum pf1 pf2) n w =
  (cls_val_process Mkt pf1) n w + (cls_val_process Mkt pf2) n w"
  by (metis (no_types, lifting) assms(1) assms(2) sum_cls_val_process0 sum_cls_val_process_Suc up_cl_proc.elims)

lemma mult_comp_cls_val_process0:
  assumes "portfolio pf1"
  shows "w. cls_val_process Mkt (qty_mult_comp pf1 qty) 0 w =
  ((cls_val_process Mkt pf1) 0 w) * (qty (Suc 0) w)" unfolding cls_val_process_def
  by (simp add: assms mult_comp_portfolio mult_comp_val_process)

lemma mult_comp_cls_val_process_Suc:
  assumes "portfolio pf1"
  shows "n w. cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w =
  ((cls_val_process Mkt pf1) (Suc n) w) * (qty (Suc n) w)"
proof (intro allI)
  fix n w
  have pf:"portfolio (qty_mult_comp pf1 qty)" using assms by (simp add:mult_comp_portfolio)
  have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
  have "((cls_val_process Mkt pf1) (Suc n) w) * (qty (Suc n) w) =
    ( x (support_set pf1). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))*(qty (Suc n) w)"
    unfolding cls_val_process_def using assms by simp
  also have "... = ( x (support_set pf1).
    (((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w) * (qty (Suc n) w)))" using sum_distrib_right by auto
  also have "... = ( x (support_set pf1).
    ((prices Mkt) x (Suc n) w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" unfolding qty_mult_comp_def
    by (simp add: mult.commute mult.left_commute)
  also have "... = ( x (support_set (qty_mult_comp pf1 qty)).
    ((prices Mkt) x (Suc n) w) * ((qty_mult_comp pf1 qty) x (Suc n) w))" using mult_comp_support_set[of pf1 qty]
    subset_cls_val_process[of "support_set pf1" "qty_mult_comp pf1 qty"] pf fin up_cl_proc.simps(2)
    unfolding cls_val_process_def by simp
  also have "... = cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w"   by (metis (no_types, lifting) pf sum.cong cls_val_process_def up_cl_proc.simps(2))
  finally have "(cls_val_process Mkt pf1) (Suc n) w * (qty (Suc n) w) = cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w" .
  thus "cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w = (cls_val_process Mkt pf1) (Suc n) w * (qty (Suc n) w)" ..
qed




lemma remove_comp_cls_val_process0:
  assumes "portfolio pf1"
  shows "w. cls_val_process Mkt (qty_rem_comp pf1 y) 0 w =
  ((cls_val_process Mkt pf1) 0 w) - (prices Mkt y 0 w)* (pf1 y (Suc 0) w)" unfolding cls_val_process_def
  by (simp add: assms remove_comp_portfolio remove_comp_val_process)


lemma remove_comp_cls_val_process_Suc:
  assumes "portfolio pf1"
  shows "n w. cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w =
  ((cls_val_process Mkt pf1) (Suc n) w) - (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
proof (intro allI)
  fix n w
  have pf:"portfolio (qty_rem_comp pf1 y)" using assms by (simp add:remove_comp_portfolio)
  have fin:"finite (support_set pf1)" using assms unfolding portfolio_def by auto
  hence fin2: "finite (support_set pf1 - {y})" by simp
  have "((cls_val_process Mkt pf1) (Suc n) w)  =
    ( x (support_set pf1). ((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))"
    unfolding cls_val_process_def using assms by simp
  also have "... = ( x (support_set pf1 - {y}).
    (((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
  proof (cases "y support_set pf1")
    case True
    thus ?thesis by (simp add: fin sum_diff1)
  next
    case False
    hence "pf1 y (Suc n) w = 0" unfolding support_set_def by simp
    thus ?thesis by (simp add: fin sum_diff1)
  qed
  also have "... = ( x (support_set pf1 - {y}).
    ((prices Mkt) x (Suc n) w) * ((qty_rem_comp pf1 y) x (Suc n) w)) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
  proof -
    have "( x (support_set pf1 - {y}). (((prices Mkt) x (Suc n) w) * (pf1 x (Suc n) w))) =
      ( x (support_set pf1 - {y}). ((prices Mkt) x (Suc n) w) * ((qty_rem_comp pf1 y) x (Suc n) w))"
    proof (rule sum.cong,simp)
      fix x
      assume "x support_set pf1 - {y}"
      show "prices Mkt x (Suc n) w * pf1 x (Suc n) w = prices Mkt x (Suc n) w * qty_rem_comp pf1 y x (Suc n) w" using remove_comp_values
        by (metis DiffD2 x  support_set pf1 - {y} singletonI)
    qed
    thus ?thesis by simp
  qed
  also have "... = (cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)"
    using subset_cls_val_process[of "support_set pf1 - {y}" "qty_rem_comp pf1 y"] fin2
    by (simp add: remove_comp_support_set)
  finally have "(cls_val_process Mkt pf1) (Suc n) w =
    (cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w) + (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)" .
  thus  "cls_val_process Mkt (qty_rem_comp pf1 y) (Suc n) w =
    ((cls_val_process Mkt pf1) (Suc n) w) - (prices Mkt y (Suc n) w)* (pf1 y (Suc n) w)" by simp
qed



lemma replace_comp_cls_val_process0:
  assumes "w. prices Mkt x 0 w = cls_val_process Mkt pf2 0 w"
  and "portfolio pf1"
  and "portfolio pf2"
shows "w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) 0 w = cls_val_process Mkt pf1 0 w"
proof
  fix w
  have "cls_val_process Mkt (qty_replace_comp pf1 x pf2) 0 w = cls_val_process Mkt (qty_rem_comp pf1 x) 0 w +
    cls_val_process Mkt (qty_mult_comp pf2 (pf1 x)) 0 w" unfolding qty_replace_comp_def using assms
    sum_cls_val_process0[of "qty_rem_comp pf1 x" "qty_mult_comp pf2 (pf1 x)"]
    by (simp add: mult_comp_portfolio remove_comp_portfolio)
  also have "... = cls_val_process Mkt pf1 0 w - (prices Mkt x 0 w * pf1 x (Suc 0) w) +
    cls_val_process Mkt pf2 0 w * pf1 x (Suc 0) w"
    by (simp add: assms(2) assms(3) mult_comp_cls_val_process0 remove_comp_cls_val_process0)
  also have "... = cls_val_process Mkt pf1 0 w" using assms by simp
  finally show "cls_val_process Mkt (qty_replace_comp pf1 x pf2) 0 w = cls_val_process Mkt pf1 0 w" .
qed


lemma replace_comp_cls_val_process_Suc:
  assumes "n w. prices Mkt x (Suc n) w = cls_val_process Mkt pf2 (Suc n) w"
  and "portfolio pf1"
  and "portfolio pf2"
  shows "n w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt pf1 (Suc n) w"
proof (intro allI)
  fix n w
  have "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt (qty_rem_comp pf1 x) (Suc n) w +
    cls_val_process Mkt (qty_mult_comp pf2 (pf1 x)) (Suc n) w" unfolding qty_replace_comp_def using assms
    sum_cls_val_process_Suc[of "qty_rem_comp pf1 x" "qty_mult_comp pf2 (pf1 x)"]
    by (simp add: mult_comp_portfolio remove_comp_portfolio)
  also have "... = cls_val_process Mkt pf1 (Suc n) w - (prices Mkt x (Suc n) w * pf1 x (Suc n) w) +
    cls_val_process Mkt pf2 (Suc n) w * pf1 x (Suc n) w"
    by (simp add: assms(2) assms(3) mult_comp_cls_val_process_Suc remove_comp_cls_val_process_Suc)
  also have "... = cls_val_process Mkt pf1 (Suc n) w" using assms by simp
  finally show "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt pf1 (Suc n) w" .
qed


lemma replace_comp_cls_val_process:
  assumes "n w. prices Mkt x n w = cls_val_process Mkt pf2 n w"
  and "portfolio pf1"
  and "portfolio pf2"
  shows "n w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) n w = cls_val_process Mkt pf1 n w"
  by (metis (no_types, lifting) assms replace_comp_cls_val_process0 replace_comp_cls_val_process_Suc up_cl_proc.elims)


lemma qty_single_updated:
  shows "cls_val_process Mkt (qty_single asset qty) (Suc n) w =
    prices Mkt asset (Suc n) w * qty (Suc n) w"
proof -
  have "cls_val_process Mkt (qty_single asset qty) (Suc n) w =
    (sum (λx. ((prices Mkt) x (Suc n) w) * ((qty_single asset qty) x (Suc n) w)) {asset})"
  proof (rule subset_cls_val_process')
    show "finite {asset}" by simp
    show "support_set (qty_single asset qty)  {asset}" by (simp add: single_comp_support)
  qed
  also have "... = prices Mkt asset (Suc n) w * qty (Suc n) w" unfolding qty_single_def by simp
  finally show ?thesis .
qed



paragraph ‹Self-financing›

definition self_financing where
  "self_financing Mkt p  (n. val_process Mkt p (Suc n) = cls_val_process Mkt p (Suc n))"


lemma self_financingE:
  assumes "self_financing Mkt p"
  shows "n. val_process Mkt p n = cls_val_process Mkt p n"
proof
  fix n
  show "val_process Mkt p n = cls_val_process Mkt p n"
  proof (cases "n = 0")
    case False
    thus ?thesis using assms unfolding self_financing_def
      by (metis up_cl_proc.elims)
  next
    case True
    thus ?thesis by (simp add: cls_val_process_def val_process_def)
  qed
qed




lemma static_portfolio_self_financing:
  assumes " x  support_set p. (w i. p x i w = p x (Suc i) w)"
  shows "self_financing Mkt p"
unfolding self_financing_def
proof (intro allI impI)
  fix n
  show "val_process Mkt p (Suc n) = cls_val_process Mkt p (Suc n)"
  proof (cases "portfolio p")
    case False
    thus ?thesis unfolding val_process_def cls_val_process_def by simp
  next
    case True
    have "w. (x support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w) =
         cls_val_process Mkt p (Suc n) w"
    proof
      fix w
      show "(x support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w) =
           cls_val_process Mkt p (Suc n) w"
      proof -
        have "(x support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w) =
            (x support_set p. prices Mkt x (Suc n) w * p x (Suc n) w)"
        proof (rule sum.cong, simp)
          fix x
          assume "x support_set p"
          hence "p x (Suc n) w = p x (Suc (Suc n)) w" using assms by blast
          thus "prices Mkt x (Suc n) w * p x (Suc (Suc n)) w = prices Mkt x (Suc n) w * p x (Suc n) w" by simp
        qed
        also have "... = cls_val_process Mkt p (Suc n) w"
           using up_cl_proc.simps(2)[of Mkt p n] by (metis True cls_val_process_def)
        finally show ?thesis .
      qed
    qed
    moreover have "w. val_process Mkt p (Suc n) w = (x support_set p. prices Mkt x (Suc n) w * p x (Suc (Suc n)) w)"
      unfolding val_process_def using True by simp
    ultimately show ?thesis by auto
  qed
qed



lemma sum_self_financing:
  assumes "portfolio pf1"
  and "portfolio pf2"
  and "self_financing Mkt pf1"
  and "self_financing Mkt pf2"
shows "self_financing Mkt (qty_sum pf1 pf2)"
proof -
  have " n w. val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
    cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w"
  proof (intro allI)
    fix n w
    have "val_process Mkt (qty_sum pf1 pf2) (Suc n) w = val_process Mkt pf1 (Suc n) w + val_process Mkt pf2 (Suc n) w"
      using assms by (simp add:sum_val_process)
    also have "... = cls_val_process Mkt pf1 (Suc n) w + val_process Mkt pf2 (Suc n) w" using assms
      unfolding self_financing_def by simp
    also have "... = cls_val_process Mkt pf1 (Suc n) w + cls_val_process Mkt pf2 (Suc n) w"
      using assms unfolding self_financing_def by simp
    also have "... = cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w" using assms by (simp add: sum_cls_val_process)
    finally show "val_process Mkt (qty_sum pf1 pf2) (Suc n) w =
      cls_val_process Mkt (qty_sum pf1 pf2) (Suc n) w" .
  qed
  thus ?thesis unfolding self_financing_def by auto
qed

lemma mult_time_constant_self_financing:
  assumes "portfolio pf1"
  and "self_financing Mkt pf1"
  and "n w. qty n w = qty (Suc n) w"
shows "self_financing Mkt (qty_mult_comp pf1 qty)"
proof -
  have " n w. val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w =
    cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w"
  proof (intro allI)
    fix n w
    have "val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w = val_process Mkt pf1 (Suc n) w * qty (Suc n) w"
      using assms by (simp add:mult_comp_val_process)
    also have "... = cls_val_process Mkt pf1 (Suc n) w * qty (Suc n) w" using assms
      unfolding self_financing_def by simp
    also have "... = cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w" using assms
       by (auto simp add: mult_comp_cls_val_process_Suc)
    finally show "val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w =
      cls_val_process Mkt (qty_mult_comp pf1 qty) (Suc n) w" .
  qed
  thus ?thesis unfolding self_financing_def by auto
qed



lemma replace_comp_self_financing:
  assumes "n w. prices Mkt x n w = cls_val_process Mkt pf2 n w"
  and "portfolio pf1"
  and "portfolio pf2"
  and "self_financing Mkt pf1"
  and "self_financing Mkt pf2"
shows "self_financing Mkt (qty_replace_comp pf1 x pf2)"
proof -
  have sfeq: "n w. prices Mkt x n w = val_process Mkt pf2 n w" using assms by (simp add: self_financingE)
  have " n w. cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w =
    val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w"
  proof (intro allI)
    fix n w
    have "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w = cls_val_process Mkt pf1 (Suc n) w"
      using assms by (simp add:replace_comp_cls_val_process)
    also have "... = val_process Mkt pf1 (Suc n) w" using assms unfolding self_financing_def by simp
    also have "... = val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w"
      using assms sfeq by (simp add: replace_comp_val_process self_financing_def)
    finally show "cls_val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w =
      val_process Mkt (qty_replace_comp pf1 x pf2) (Suc n) w" .
  qed
  thus ?thesis unfolding self_financing_def by auto
qed




paragraph ‹Make a portfolio self-financing›

fun  remaining_qty where
  init: "remaining_qty Mkt v pf asset 0 = (λw. 0)" |
  first:  "remaining_qty Mkt v pf asset (Suc 0) = (λw. (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))" |
  step: "remaining_qty Mkt v pf asset (Suc (Suc n)) = (λw. (remaining_qty Mkt v pf asset (Suc n) w) +
    (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w))"

lemma (in disc_equity_market) remaining_qty_predict':
  assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
  and "trading_strategy pf"
and "support_adapt Mkt pf"
shows "remaining_qty Mkt v pf asset (Suc n)  borel_measurable (F n)"
proof (induct n)
  case 0
  have "(λw. (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w)) borel_measurable (F 0)"
  proof (rule borel_measurable_divide)
    have "val_process Mkt pf 0  borel_measurable (F 0)" using assms
      ats_val_process_adapted by (simp add:adapt_stoch_proc_def)
    thus "(λx. v - val_process Mkt pf 0 x)  borel_measurable (F 0)" by simp
    show "prices Mkt asset 0  borel_measurable (F 0)" using assms unfolding adapt_stoch_proc_def by simp
  qed
  thus ?case by simp
next
  case (Suc n)
  have "(λw. (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/
    (prices Mkt asset (Suc n) w))  borel_measurable (F (Suc n))"
  proof (rule borel_measurable_divide)
    show "(λw. (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w))  borel_measurable (F (Suc n))"
    proof (rule borel_measurable_diff)
      show "(λw. (cls_val_process Mkt pf (Suc n) w))  borel_measurable (F (Suc n))"
        using assms cls_val_process_adapted unfolding adapt_stoch_proc_def by auto
      show "(λw. (val_process Mkt pf (Suc n) w))  borel_measurable (F (Suc n))"
        using assms  ats_val_process_adapted by (simp add:adapt_stoch_proc_def)
    qed
    show "prices Mkt asset (Suc n)  borel_measurable (F (Suc n))" using assms unfolding adapt_stoch_proc_def by simp
  qed
  moreover have "remaining_qty Mkt v pf asset (Suc n)  borel_measurable (F (Suc n))" using Suc
    Suc_n_not_le_n increasing_measurable_info nat_le_linear by blast
  ultimately show ?case using Suc remaining_qty.simps(3)[of Mkt v pf asset n] by simp
qed

lemma (in disc_equity_market) remaining_qty_predict:
  assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
  and "trading_strategy pf"
and "support_adapt Mkt pf"
shows "borel_predict_stoch_proc F (remaining_qty Mkt v pf asset)"  unfolding predict_stoch_proc_def
proof (intro conjI allI)
  show "remaining_qty Mkt v pf asset 0  borel_measurable (F 0)" using init by simp
  fix n
  show "remaining_qty Mkt v pf asset (Suc n)  borel_measurable (F n)" using assms by (simp add: remaining_qty_predict')
qed


lemma (in disc_equity_market) remaining_qty_adapt:
  assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
  and "trading_strategy pf"
and "support_adapt Mkt pf"
shows "remaining_qty Mkt v pf asset n  borel_measurable (F n)"
  using adapt_stoch_proc_def assms(1) assms(2) predict_imp_adapt remaining_qty_predict
  by (metis assms(3))


lemma (in disc_equity_market) remaining_qty_adapted:
  assumes "borel_adapt_stoch_proc F (prices Mkt asset)"
  and "trading_strategy pf"
and "support_adapt Mkt pf"
shows "borel_adapt_stoch_proc F (remaining_qty Mkt v pf asset)" using assms unfolding adapt_stoch_proc_def
  using assms remaining_qty_adapt by blast


definition self_finance where
  "self_finance Mkt v pf (asset::'a) = qty_sum pf (qty_single asset (remaining_qty Mkt v pf asset))"


lemma self_finance_portfolio:
  assumes "portfolio pf"
shows "portfolio (self_finance Mkt v pf asset)" unfolding self_finance_def
  by (simp add: assms single_comp_portfolio sum_portfolio)


lemma self_finance_init:
  assumes "w. prices Mkt asset 0 w  0"
  and "portfolio pf"
shows "val_process Mkt (self_finance Mkt v pf asset) 0 w = v"
proof -
  define scp where "scp = qty_single asset (remaining_qty Mkt v pf asset)"
  have "val_process Mkt (self_finance Mkt v pf asset) 0 w =
    val_process Mkt pf 0 w +
    val_process Mkt scp 0 w" unfolding scp_def using assms single_comp_portfolio[of asset]
    sum_val_process[of pf "qty_single asset (remaining_qty Mkt v pf asset)" Mkt]
    by (simp add: qty. portfolio (qty_single asset qty) self_finance_def)
  also have "... = val_process Mkt pf 0 w +
    (sum (λx. ((prices Mkt) x 0 w) * (scp x (Suc 0) w)) {asset})"
    using subset_val_process'[of "{asset}" scp] unfolding scp_def by (auto simp add:  single_comp_support)
  also have "... = val_process Mkt pf 0 w + prices Mkt asset 0 w * scp asset (Suc 0) w" by auto
  also have "... = val_process Mkt pf 0 w + prices Mkt asset 0 w * (remaining_qty Mkt v pf asset) (Suc 0) w"
    unfolding scp_def qty_single_def by simp
  also have "... = val_process Mkt pf 0 w + prices Mkt asset 0 w * (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w)"
    by simp
  also have "... = val_process Mkt pf 0 w + (v - val_process Mkt pf 0 w)" using assms by simp
  also have "... = v" by simp
  finally show ?thesis .
qed


lemma self_finance_succ:
  assumes "prices Mkt asset (Suc n) w  0"
  and "portfolio pf"
shows "val_process Mkt (self_finance Mkt v pf asset) (Suc n) w = prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w +
  cls_val_process Mkt pf (Suc n) w"
proof -
  define scp where "scp = qty_single asset (remaining_qty Mkt v pf asset)"
  have "val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
    val_process Mkt pf (Suc n) w +
    val_process Mkt scp (Suc n) w" unfolding scp_def using assms single_comp_portfolio[of asset]
    sum_val_process[of pf "qty_single asset (remaining_qty Mkt v pf asset)" Mkt]
    by (simp add: qty. portfolio (qty_single asset qty) self_finance_def)
  also have "... = val_process Mkt pf (Suc n) w +
    (sum (λx. ((prices Mkt) x (Suc n) w) * (scp x (Suc (Suc n)) w)) {asset})"
    using subset_val_process'[of "{asset}" scp] unfolding scp_def by (auto simp add:  single_comp_support)
  also have "... = val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * scp asset (Suc (Suc n)) w" by auto
  also have "... = val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * (remaining_qty Mkt v pf asset) (Suc (Suc n)) w"
    unfolding scp_def qty_single_def by simp
  also have "... = val_process Mkt pf (Suc n) w +
    prices Mkt asset (Suc n) w *
    (remaining_qty Mkt v pf asset (Suc n) w + (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w))"
    by simp
  also have "... = val_process Mkt pf (Suc n) w +
     prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w +
    prices Mkt asset (Suc n) w * (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w)"
     by (simp add: distrib_left)
  also have "... = val_process Mkt pf (Suc n) w +
     prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w + (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)"
     using assms by simp
  also have "... = prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w + cls_val_process Mkt pf (Suc n) w" by simp
  finally show ?thesis .
qed


lemma self_finance_updated:
  assumes "prices Mkt asset (Suc n) w  0"
  and "portfolio pf"
shows "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
  cls_val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * (remaining_qty Mkt v pf asset) (Suc n) w"
proof -
  define scp where "scp = qty_single asset (remaining_qty Mkt v pf asset)"
  have "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
    cls_val_process Mkt pf (Suc n) w +
    cls_val_process Mkt scp (Suc n) w" unfolding scp_def using assms single_comp_portfolio[of asset]
    sum_cls_val_process[of pf "qty_single asset (remaining_qty Mkt v pf asset)" Mkt]
    by (simp add: qty. portfolio (qty_single asset qty) self_finance_def)
  also have "... = cls_val_process Mkt pf (Suc n) w +
    (sum (λx. ((prices Mkt) x (Suc n) w) * (scp x (Suc n) w)) {asset})"
    using subset_cls_val_process[of "{asset}" scp] unfolding scp_def by (auto simp add:  single_comp_support)
  also have "... = cls_val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * scp asset (Suc n) w" by auto
  also have "... = cls_val_process Mkt pf (Suc n) w + prices Mkt asset (Suc n) w * (remaining_qty Mkt v pf asset) (Suc n) w"
    unfolding scp_def qty_single_def by simp
  finally show ?thesis .
qed

lemma self_finance_charact:
  assumes " n w. prices Mkt asset (Suc n) w  0"
  and "portfolio pf"
shows "self_financing Mkt (self_finance Mkt v pf asset)"
proof-
  have "n w. val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
     cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w"
  proof (intro allI)
    fix n w
    show "val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
      cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w" using assms self_finance_succ[of Mkt asset]
      by (simp add: self_finance_updated)
  qed
  thus ?thesis unfolding self_financing_def by auto
qed


subsubsection ‹Replicating portfolios›


definition (in disc_filtr_prob_space) price_structure::"('a  real)  nat  real  (nat  'a  real)  bool" where
  "price_structure pyf T π pr  (( w space M. pr 0 w = π)  (AE w in M. pr T w = pyf w)  (pr T  borel_measurable (F T)))"

lemma (in disc_filtr_prob_space) price_structure_init:
  assumes "price_structure pyf T π pr"
  shows " w space M. pr 0 w = π" using assms unfolding price_structure_def by simp

lemma (in disc_filtr_prob_space) price_structure_borel_measurable:
  assumes "price_structure pyf T π pr"
  shows "pr T  borel_measurable (F T)" using assms unfolding price_structure_def by simp

lemma (in disc_filtr_prob_space) price_structure_maturity:
  assumes "price_structure pyf T π pr"
  shows "AE w in M. pr T w = pyf w" using assms unfolding price_structure_def by simp

definition (in disc_equity_market) replicating_portfolio where
  "replicating_portfolio pf der matur   (stock_portfolio Mkt pf)  (trading_strategy pf)  (self_financing Mkt pf) 
  (AE w in M. cls_val_process Mkt pf matur w = der w)"


definition (in disc_equity_market) is_attainable where
  "is_attainable der matur  ( pf. replicating_portfolio pf der matur)"

lemma (in disc_equity_market) replicating_price_process:
  assumes "replicating_portfolio pf der matur"
and "support_adapt Mkt pf"
  shows "price_structure der matur (initial_value pf) (cls_val_process Mkt pf)"
  unfolding price_structure_def
proof (intro conjI)
  show "AE w in M. cls_val_process Mkt pf matur w = der w" using assms unfolding replicating_portfolio_def by simp
  show "wspace M. cls_val_process Mkt pf 0 w = initial_value pf"
  proof
    fix w
    assume "w space M"
    thus "cls_val_process Mkt pf 0 w = initial_value pf" unfolding initial_value_def using constant_imageI[of "cls_val_process Mkt pf 0"]
      trading_strategy_init[of pf] assms replicating_portfolio_def [of pf der matur]
      by (simp add: stock_portfolio_def cls_val_process_def)
  qed
  show "cls_val_process Mkt pf matur  borel_measurable (F matur)" using assms unfolding replicating_portfolio_def
    using ats_val_process_adapted[of pf]
    cls_val_process_adapted by (simp add:adapt_stoch_proc_def)
qed


subsubsection ‹Arbitrages›


definition (in disc_filtr_prob_space) arbitrage_process
where
  "arbitrage_process Mkt p  ( m. (self_financing Mkt p)  (trading_strategy p) 
    (w  space M. val_process Mkt p 0 w = 0) 
    (AE w in M. 0  cls_val_process Mkt p m w) 
    0 < 𝒫(w in M. cls_val_process Mkt p m w > 0))"

lemma (in disc_filtr_prob_space) arbitrage_processE:
  assumes "arbitrage_process Mkt p"
  shows "( m. (self_financing Mkt p)  (trading_strategy p) 
    (w  space M. cls_val_process Mkt p 0 w = 0) 
    (AE w in M. 0  cls_val_process Mkt p m w) 
    0 < 𝒫(w in M. cls_val_process Mkt p m w > 0))"
  using assms disc_filtr_prob_space.arbitrage_process_def disc_filtr_prob_space_axioms self_financingE by fastforce



lemma (in disc_filtr_prob_space) arbitrage_processI:
  assumes "( m. (self_financing Mkt p)  (trading_strategy p) 
    (w  space M. cls_val_process Mkt p 0 w = 0) 
    (AE w in M. 0  cls_val_process Mkt p m w) 
    0 < 𝒫(w in M. cls_val_process Mkt p m w > 0))"
  shows "arbitrage_process Mkt p" unfolding arbitrage_process_def  using assms
  by (simp add: self_financingE cls_val_process_def)

definition (in disc_filtr_prob_space) viable_market
where
  "viable_market Mkt   (p. stock_portfolio Mkt p  ¬ arbitrage_process Mkt p)"

lemma (in disc_filtr_prob_space) arbitrage_val_process:
  assumes "arbitrage_process Mkt pf1"
  and "self_financing Mkt pf2"
  and "trading_strategy pf2"
  and " n w. cls_val_process Mkt pf1 n w = cls_val_process Mkt pf2 n w"
shows "arbitrage_process Mkt pf2"
proof -
  have "( m. (self_financing Mkt pf1)  (trading_strategy pf1) 
    (w  space M. cls_val_process Mkt pf1 0 w = 0) 
    (AE w in M. 0  cls_val_process Mkt pf1 m w) 
    0 < 𝒫(w in M. cls_val_process Mkt pf1 m w > 0))" using assms arbitrage_processE[of Mkt pf1] by simp
  from this obtain m where "(self_financing Mkt pf1)" and "(trading_strategy pf1)" and
    "(w  space M. cls_val_process Mkt pf1 0 w = 0)" and
    "(AE w in M. 0  cls_val_process Mkt pf1 m w)"
    "0 < 𝒫(w in M. cls_val_process Mkt pf1 m w > 0)" by auto
  have ae_eq:"w space M. (cls_val_process Mkt pf1 0 w = 0) = (cls_val_process Mkt pf2 0 w = 0)"
  proof
    fix w
    assume "w space M"
    show "(cls_val_process Mkt pf1 0 w = 0) = (cls_val_process Mkt pf2 0 w = 0) "
      using  assms  by simp
  qed
  have ae_geq:"almost_everywhere M (λw. cls_val_process Mkt pf1 m w  0) = almost_everywhere M (λw. cls_val_process Mkt pf2 m w  0)"
  proof (rule AE_cong)
    fix w
    assume "w space M"
    show "(cls_val_process Mkt pf1 m w  0) = (cls_val_process Mkt pf2 m w  0) "
      using  assms by simp
  qed
  have "self_financing Mkt pf2" using assms by simp
  moreover have "trading_strategy pf2" using assms by simp
  moreover have "(w  space M. cls_val_process Mkt pf2 0 w = 0)"  using (w  space M. cls_val_process Mkt pf1 0 w = 0) ae_eq by simp
  moreover have "AE w in M. 0  cls_val_process Mkt pf2 m w" using AE w in M. 0  cls_val_process Mkt pf1 m w ae_geq by simp
  moreover have "0 < prob {w  space M. 0 < cls_val_process Mkt pf2 m w}"
  proof -
    have "{w  space M. 0 < cls_val_process Mkt pf2 m w} = {w  space M. 0 < cls_val_process Mkt pf1 m w}"
      by (simp add: assms(4))
    thus ?thesis by (simp add: 0 < prob {w  space M. 0 < cls_val_process Mkt pf1 m w})
  qed
  ultimately show ?thesis using arbitrage_processI by blast
qed


definition coincides_on where
  "coincides_on Mkt Mkt2 A  (stocks Mkt = stocks Mkt2  (x. x A  prices Mkt x = prices Mkt2 x))"

lemma coincides_val_process:
  assumes "coincides_on Mkt Mkt2 A"
  and "support_set pf  A"
  shows "n w. val_process Mkt pf n w = val_process Mkt2 pf n w"
proof (intro allI)
  fix n w
  show "val_process Mkt pf n w = val_process Mkt2 pf n w"
  proof (cases "portfolio pf")
    case False
    thus ?thesis unfolding val_process_def by simp
  next
    case True
    hence "val_process Mkt pf n w = (x support_set pf. prices Mkt x n w * pf x (Suc n) w)" using assms
      unfolding val_process_def  by simp
    also have "... = (x support_set pf. prices Mkt2 x n w * pf x (Suc n) w)"
    proof (rule sum.cong, simp)
      fix y
      assume "y support_set pf"
      hence "y A" using assms unfolding  stock_portfolio_def by auto
      hence "prices Mkt y n w = prices Mkt2 y n w" using assms
        unfolding coincides_on_def by auto
      thus "prices Mkt y n w * pf y (Suc n) w = prices Mkt2 y n w * pf y (Suc n) w" by simp
    qed
    also have "... = val_process Mkt2 pf n w"
      by (metis (mono_tags, lifting) calculation val_process_def)
    finally show "val_process Mkt pf n w = val_process Mkt2 pf n w" .
  qed
qed

lemma coincides_cls_val_process':
  assumes "coincides_on Mkt Mkt2 A"
  and "support_set pf  A"
  shows "n w. cls_val_process Mkt pf (Suc n) w = cls_val_process Mkt2 pf (Suc n) w"
proof (intro allI)
  fix n w
  show "cls_val_process Mkt pf (Suc n) w = cls_val_process Mkt2 pf (Suc n) w"
  proof (cases "portfolio pf")
    case False
    thus ?thesis unfolding cls_val_process_def by simp
  next
    case True
    hence "cls_val_process Mkt pf (Suc n) w = (x support_set pf. prices Mkt x (Suc n) w * pf x (Suc n) w)" using assms
      unfolding cls_val_process_def  by simp
    also have "... = (x support_set pf. prices Mkt2 x (Suc n) w * pf x (Suc n) w)"
    proof (rule sum.cong, simp)
      fix y
      assume "y support_set pf"
      hence "y A" using assms unfolding  stock_portfolio_def by auto
      hence "prices Mkt y (Suc n) w = prices Mkt2 y (Suc n) w" using assms
        unfolding coincides_on_def by auto
      thus "prices Mkt y (Suc n) w * pf y (Suc n) w = prices Mkt2 y (Suc n) w * pf y (Suc n) w" by simp
    qed
    also have "... = cls_val_process Mkt2 pf (Suc n) w"
      by (metis (mono_tags, lifting) True  up_cl_proc.simps(2) cls_val_process_def)
    finally show "cls_val_process Mkt pf (Suc n) w = cls_val_process Mkt2 pf (Suc n) w" .
  qed
qed

lemma coincides_cls_val_process:
  assumes "coincides_on Mkt Mkt2 A"
  and "support_set pf  A"
  shows "n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
proof (intro allI)
  fix n w
  show "cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
  proof (cases "portfolio pf")
    case False
    thus ?thesis unfolding cls_val_process_def by simp
  next
    case True
    show "cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
    proof (induct n)
      case 0
      with assms show ?case
        by (simp add: cls_val_process_def coincides_val_process)
    next
      case Suc
      thus ?case using coincides_cls_val_process' assms by blast
    qed
  qed
qed


lemma (in disc_filtr_prob_space) coincides_on_self_financing:
  assumes "coincides_on Mkt Mkt2 A"
  and "support_set p  A"
  and "self_financing Mkt p"
shows "self_financing Mkt2 p"
proof -
  have " n w. val_process Mkt2 p (Suc n) w = cls_val_process Mkt2 p (Suc n) w"
  proof (intro allI)
    fix n w
    have "val_process Mkt2 p (Suc n) w = val_process Mkt p (Suc n) w"
      using assms(1) assms(2) coincides_val_process stock_portfolio_def by fastforce
    also have "... = cls_val_process Mkt p (Suc n) w" by (metis ‹self_financing Mkt p self_financing_def)
    also have "... = cls_val_process Mkt2 p (Suc n) w"
      using assms(1) assms(2) coincides_cls_val_process stock_portfolio_def by blast
    finally show "val_process Mkt2 p (Suc n) w = cls_val_process Mkt2 p (Suc n) w" .
  qed
  thus "self_financing Mkt2 p" unfolding self_financing_def by auto
qed


lemma (in disc_filtr_prob_space) coincides_on_arbitrage:
  assumes "coincides_on Mkt Mkt2 A"
  and "support_set p  A"
  and "arbitrage_process Mkt p"
shows "arbitrage_process Mkt2 p"
proof -
  have "( m. (self_financing Mkt p)  (trading_strategy p) 
    (w space M. cls_val_process Mkt p 0 w = 0) 
    (AE w in M. 0  cls_val_process Mkt p m w) 
    0 < 𝒫(w in M. cls_val_process Mkt p m w > 0))" using assms using arbitrage_processE by simp
  from this obtain m where "(self_financing Mkt p)" and "(trading_strategy p)" and
    "(w space M. cls_val_process Mkt p 0 w = 0)" and
    "(AE w in M. 0  cls_val_process Mkt p m w)"
    "0 < 𝒫(w in M. cls_val_process Mkt p m w > 0)" by auto
  have ae_eq:"w space M. (cls_val_process Mkt2 p 0 w = 0) = (cls_val_process Mkt p 0 w = 0)"
  proof
    fix w
    assume "w space M"
    show "(cls_val_process Mkt2 p 0 w = 0) = (cls_val_process Mkt p 0 w = 0) "
      using  assms coincides_cls_val_process by (metis)
  qed
  have ae_geq:"almost_everywhere M (λw. cls_val_process Mkt2 p m w  0) = almost_everywhere M (λw. cls_val_process Mkt p m w  0)"
  proof (rule AE_cong)
    fix w
    assume "w space M"
    show "(cls_val_process Mkt2 p m w  0) = (cls_val_process Mkt p m w  0) "
      using  assms coincides_cls_val_process by (metis)
  qed
  have "self_financing Mkt2 p" using assms coincides_on_self_financing
    using ‹self_financing Mkt p by blast
  moreover have "trading_strategy p" using ‹trading_strategy p .
  moreover have "(w space M. cls_val_process Mkt2 p 0 w = 0)"  using (w space M. cls_val_process Mkt p 0 w = 0) ae_eq by simp
  moreover have "AE w in M. 0  cls_val_process Mkt2 p m w" using AE w in M. 0  cls_val_process Mkt p m w ae_geq by simp
  moreover have "0 < prob {w  space M. 0 < cls_val_process Mkt2 p m w}"
  proof -
    have "{w  space M. 0 < cls_val_process Mkt2 p m w} = {w  space M. 0 < cls_val_process Mkt p m w}"
      by (metis (no_types, lifting) assms(1) assms(2) coincides_cls_val_process)
    thus ?thesis by (simp add: 0 < prob {w  space M. 0 < cls_val_process Mkt p m w})
  qed
  ultimately show ?thesis using arbitrage_processI by blast
qed


lemma (in disc_filtr_prob_space) coincides_on_stocks_viable:
  assumes "coincides_on Mkt Mkt2 (stocks Mkt)"
  and "viable_market Mkt"
shows "viable_market Mkt2" using coincides_on_arbitrage
  by (metis (mono_tags, hide_lams) assms(1) assms(2) coincides_on_def stock_portfolio_def viable_market_def)


lemma coincides_stocks_val_process:
  assumes "stock_portfolio Mkt pf"
  and "coincides_on Mkt Mkt2 (stocks Mkt)"
shows "n w. val_process Mkt pf n w = val_process Mkt2 pf n w" using assms  unfolding stock_portfolio_def
  by (simp add: coincides_val_process)

lemma coincides_stocks_cls_val_process:
  assumes "stock_portfolio Mkt pf"
  and "coincides_on Mkt Mkt2 (stocks Mkt)"
shows "n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w" using assms  unfolding stock_portfolio_def
    by (simp add: coincides_cls_val_process)

lemma (in disc_filtr_prob_space) coincides_on_adapted_val_process:
  assumes "coincides_on Mkt Mkt2 A"
  and "support_set p  A"
  and "borel_adapt_stoch_proc F (val_process Mkt p)"
shows "borel_adapt_stoch_proc F (val_process Mkt2 p)" unfolding adapt_stoch_proc_def
proof
  fix n
  have "val_process Mkt p n  borel_measurable (F n)" using assms unfolding adapt_stoch_proc_def by simp
  moreover have "w. val_process Mkt p n w = val_process Mkt2 p n w" using assms coincides_val_process[of Mkt Mkt2 A]
    by auto
  thus "val_process Mkt2 p n  borel_measurable (F n)"
    using calculation by presburger
qed

lemma (in disc_filtr_prob_space) coincides_on_adapted_cls_val_process:
  assumes "coincides_on Mkt Mkt2 A"
  and "support_set p  A"
  and "borel_adapt_stoch_proc F (cls_val_process Mkt p)"
shows "borel_adapt_stoch_proc F (cls_val_process Mkt2 p)" unfolding adapt_stoch_proc_def
proof
  fix n
  have "cls_val_process Mkt p n  borel_measurable (F n)" using assms unfolding adapt_stoch_proc_def by simp
  moreover have "w. cls_val_process Mkt p n w = cls_val_process Mkt2 p n w" using assms coincides_cls_val_process[of Mkt Mkt2 A]
    by auto
  thus "cls_val_process Mkt2 p n  borel_measurable (F n)"
    using calculation by presburger
qed

subsubsection ‹Fair prices›
definition (in disc_filtr_prob_space) fair_price where
  "fair_price Mkt π pyf matur 
    ( pr. price_structure pyf matur π pr 
    ( x Mkt2 p. (x stocks Mkt 
      ((coincides_on Mkt Mkt2 (stocks Mkt))  (prices Mkt2 x = pr)  portfolio p  support_set p  stocks Mkt  {x} 
        ¬ arbitrage_process Mkt2 p))))"



lemma (in disc_filtr_prob_space) fair_priceI:
  assumes "fair_price Mkt π pyf matur"
  shows "( pr. price_structure pyf matur π pr 
    ( x. (x stocks Mkt 
      ( Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt))  (prices Mkt2 x = pr)  portfolio p  support_set p  stocks Mkt  {x} 
        ¬ arbitrage_process Mkt2 p))))" using assms unfolding fair_price_def by simp

paragraph ‹Existence when replicating portfolio›


lemma (in disc_equity_market) replicating_fair_price:
  assumes "viable_market Mkt"
  and "replicating_portfolio pf der matur"
and "support_adapt Mkt pf"
shows "fair_price Mkt (initial_value pf) der matur"
proof (rule ccontr)
  define π where  "π = (initial_value pf)"
  assume "¬ fair_price Mkt π der matur"
  hence imps: "pr. (price_structure der matur π pr)   ( x Mkt2 p. (x stocks Mkt 
    (coincides_on Mkt Mkt2 (stocks Mkt))  (prices Mkt2 x = pr)  portfolio p  support_set p  stocks Mkt  {x} 
     arbitrage_process Mkt2 p))" unfolding fair_price_def by simp
  have "(price_structure der matur π (cls_val_process Mkt pf))" unfolding π_def  using replicating_price_process assms by simp
  hence " x Mkt2 p. (x stocks Mkt 
    (coincides_on Mkt Mkt2 (stocks Mkt))  (prices Mkt2 x = (cls_val_process Mkt pf))  portfolio p  support_set p  stocks Mkt  {x} 
     arbitrage_process Mkt2 p)" using imps by simp
  from this obtain x Mkt2 p where "x stocks Mkt" and "coincides_on Mkt Mkt2 (stocks Mkt)" and "prices Mkt2 x = cls_val_process Mkt pf"
    and "portfolio p" and "support_set p stocks Mkt  {x}" and "arbitrage_process Mkt2 p" by auto
  have "n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w"
    using coincides_stocks_cls_val_process[of Mkt pf Mkt2] assms ‹coincides_on Mkt Mkt2 (stocks Mkt)  unfolding replicating_portfolio_def
    by simp
  have "m. self_financing Mkt2 p 
      trading_strategy p 
      (AE w in M. cls_val_process Mkt2 p 0 w = 0) 
      (AE w in M. 0  cls_val_process Mkt2 p m w)  0 < prob {w  space M. 0 < cls_val_process Mkt2 p m w}"
    using ‹arbitrage_process Mkt2 p using arbitrage_processE[of Mkt2] by simp
  from this obtain m where "self_financing Mkt2 p"
      "trading_strategy p 
      (AE w in M. cls_val_process Mkt2 p 0 w = 0) 
      (AE w in M. 0  cls_val_process Mkt2 p m w)  0 < prob {w  space M. 0 < cls_val_process Mkt2 p m w}" by auto note mprop = this
  define eq_stock where "eq_stock = qty_replace_comp p x pf"
  have "n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w" using assms unfolding replicating_portfolio_def
      using coincides_cls_val_process
      using n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w by blast
    hence prx: "n w. prices Mkt2 x n w = cls_val_process Mkt2 pf n w" using ‹prices Mkt2 x = cls_val_process Mkt pf by simp
  have "stock_portfolio Mkt2 eq_stock"
    by (metis (no_types, lifting) ‹coincides_on Mkt Mkt2 (stocks Mkt) ‹portfolio p ‹support_set p  stocks Mkt  {x}
        assms(2) coincides_on_def disc_equity_market.replicating_portfolio_def disc_equity_market_axioms eq_stock_def
        replace_comp_portfolio replace_comp_stocks stock_portfolio_def)
  moreover have "arbitrage_process Mkt2 eq_stock"
  proof (rule arbitrage_val_process)
    show "arbitrage_process Mkt2 p" using ‹arbitrage_process Mkt2 p .
    show vp: "n w. cls_val_process Mkt2 p n w = cls_val_process Mkt2 eq_stock n w" using replace_comp_cls_val_process
        ‹prices Mkt2 x = cls_val_process Mkt pf unfolding eq_stock_def
      by (metis (no_types, lifting) n w. cls_val_process Mkt pf n w = cls_val_process Mkt2 pf n w ‹portfolio p assms(2) replicating_portfolio_def
          stock_portfolio_def)
    show "trading_strategy eq_stock"
      by (metis ‹arbitrage_process Mkt2 p arbitrage_process_def assms(2) eq_stock_def
          replace_comp_trading_strat replicating_portfolio_def)
    show "self_financing Mkt2 eq_stock" unfolding eq_stock_def
    proof (rule replace_comp_self_financing)
      show "portfolio pf" using assms unfolding replicating_portfolio_def stock_portfolio_def by simp
      show "portfolio p" using ‹portfolio p .
      show "n w. prices Mkt2 x n w = cls_val_process Mkt2 pf n w" using prx .
      show "self_financing Mkt2 p" using ‹self_financing Mkt2 p .
      show "self_financing Mkt2 pf" using coincides_on_self_financing[of Mkt Mkt2 "stocks Mkt" pf]
        ‹coincides_on Mkt Mkt2 (stocks Mkt) assms(2) (*disc_equity_market.replicating_portfolio_def
          disc_equity_market_axioms*) unfolding stock_portfolio_def replicating_portfolio_def by auto
    qed
  qed
  moreover have "viable_market Mkt2" using assms coincides_on_stocks_viable[of Mkt Mkt2]
    by (simp add: ‹coincides_on Mkt Mkt2 (stocks Mkt))
  ultimately show False unfolding viable_market_def by simp
qed


paragraph ‹Uniqueness when replicating portfolio›


text ‹The proof of uniqueness requires the existence of a stock that always takes strictly positive values.›


locale disc_market_pos_stock = disc_equity_market +
  fixes pos_stock
  assumes in_stock: "pos_stock  stocks Mkt"
  and positive: " n w. prices Mkt pos_stock n w > 0"
and readable: " asset stocks Mkt. borel_adapt_stoch_proc F (prices Mkt asset)"




lemma (in disc_market_pos_stock) pos_stock_borel_adapted:
  shows "borel_adapt_stoch_proc F (prices Mkt pos_stock)"
  using assets_def readable in_stock  by auto


definition static_quantities where
  "static_quantities p  (asset  support_set p. c::real. p asset = (λ n w. c))"

lemma (in disc_filtr_prob_space) static_quantities_trading_strat:
  assumes "static_quantities p"
  and "finite (support_set p)"
  shows "trading_strategy p" unfolding trading_strategy_def
proof (intro conjI ballI)
  show "portfolio p" using assms unfolding portfolio_def by simp
  fix asset
  assume "asset  support_set p"
  hence "c. p asset = (λ n w. c)" using assms unfolding static_quantities_def by simp
  then obtain c where "p asset = (λ n w. c)" by auto
  show "borel_predict_stoch_proc F (p asset)" unfolding predict_stoch_proc_def
  proof (intro conjI)
    show "p asset 0  borel_measurable (F 0)" using p asset = (λ n w. c) by simp
    show "n. p asset (Suc n)  borel_measurable (F n)"
    proof
    fix n
      have "p asset (Suc n) = (λ w. c)" using p asset = (λ n w. c) by simp
      thus "p asset (Suc n)  borel_measurable (F n)" by simp
    qed
  qed
qed



lemma two_component_support_set:
  assumes " n w. a n w  0"
  and " n w. b n w 0"
  and "x  y"
shows "support_set ((λ (x::'b) (n::nat) (w::'a). 0::real)(x:= a, y:= b)) = {x,y}"
proof
  let ?arb_pf = "(λ (x::'b) (n::nat) (w::'a). 0::real)(x:= a, y:= b)"
  have " n w. ?arb_pf x n w  0" using assms by simp
  moreover have "n w. ?arb_pf y n w  0" using assms by simp
  ultimately show "{x, y}  support_set ?arb_pf" unfolding support_set_def by simp
  show "support_set ?arb_pf  {x, y}"
  proof (rule ccontr)
    assume "¬ support_set ?arb_pf  {x, y}"
    hence "z. z support_set ?arb_pf  z {x, y}" by auto
    from this obtain z where "z support_set ?arb_pf" and "z {x, y}" by auto
    have "n w. ?arb_pf z n w  0" using z support_set ?arb_pf unfolding support_set_def by simp
    from this obtain n w where "?arb_pf z n w  0" by auto
    have "?arb_pf z n w = 0" using z {x, y}  by simp
    thus False using ?arb_pf z n w  0 by simp
  qed
qed

lemma two_component_val_process:
  assumes "arb_pf = ((λ (x::'b) (n::nat) (w::'a). 0::real)(x:= a, y:= b))"
  and "portfolio arb_pf"
  and "x  y"
  and " n w. a n w  0"
  and " n w. b n w 0"
  shows "val_process Mkt arb_pf n w =
    prices Mkt y n w * b (Suc n) w + prices Mkt x n w * a (Suc n) w"
proof -
  have "support_set arb_pf = {x,y}" using assms by (simp add:two_component_support_set)
  have "val_process Mkt arb_pf n w = (xsupport_set arb_pf. prices Mkt x n w * arb_pf x (Suc n) w)"
        unfolding val_process_def using ‹portfolio arb_pf by simp
  also have "... = (x{x, y}. prices Mkt x n w * arb_pf x (Suc n) w)" using ‹support_set arb_pf = {x, y}
        by simp
  also have "... = (x{y}. prices Mkt x n w * arb_pf x (Suc n) w) + prices Mkt x n w * arb_pf x (Suc n) w"
        using sum.insert[of "{y}" x  "λx. prices Mkt x n w * arb_pf x n w"] assms(3) by auto
  also have "... = prices Mkt y n w * arb_pf y (Suc n) w + prices Mkt x n w * arb_pf x (Suc n) w" by simp
  also have "... = prices Mkt y n w * b (Suc n) w + prices Mkt x n w * a (Suc n) w" using assms by auto
  finally show "val_process Mkt arb_pf n w = prices Mkt y n w * b (Suc n) w + prices Mkt x n w * a (Suc n) w" .
qed

lemma quantity_update_support_set:
  assumes "n w. pr n w  0"
  and "x support_set p"
shows "support_set (p(x:=pr)) = support_set p  {x}"
proof
  show "support_set (p(x := pr))  support_set p  {x}"
  proof
    fix y
    assume "y support_set (p(x := pr))"
    show "y  support_set p  {x}"
    proof (rule ccontr)
      assume "¬y  support_set p  {x}"
      hence "y  x" by simp
      have "n w. (p(x := pr)) y n w  0" using y support_set (p(x := pr)) unfolding support_set_def by simp
      then obtain n w where nwprop: "(p(x := pr)) y n w  0" by auto
      have "y support_set p" using ¬y  support_set p  {x} by simp
      hence "y = x" using nwprop using support_set_def by force
      thus False using y x by simp
    qed
  qed
  show "support_set p  {x}  support_set (p(x := pr))"
  proof
    fix y
    assume "y  support_set p  {x}"
    show "y support_set (p(x := pr))"
    proof (cases "y support_set p")
      case True
      thus ?thesis
      proof -
        have f1: "y  {b. n a. p b n a  0}"
          by (metis True support_set_def)
        then have "y  x"
          using assms(2) support_set_def by force
        then show ?thesis
          using f1 by (simp add: support_set_def)
      qed
    next
      case False
      hence "y = x" using y  support_set p  {x} by auto
      thus ?thesis using assms by (simp add: support_set_def)
    qed
  qed
qed


lemma fix_asset_price:
  shows "x Mkt2. x  stocks Mkt 
  coincides_on Mkt Mkt2 (stocks Mkt) 
  prices Mkt2 x = pr"
proof -
  have "x. x stocks Mkt" by (metis UNIV_eq_I stk_strict_subs_def mkt_stocks_assets)
  from this obtain x where "x stocks Mkt" by auto
  let ?res = "discrete_market_of (stocks Mkt) ((prices Mkt)(x:=pr))"
  have "coincides_on Mkt ?res (stocks Mkt)"
  proof -
    have "stocks Mkt = stocks (discrete_market_of (stocks Mkt) ((prices Mkt)(x := pr)))"
      by (metis (no_types) stk_strict_subs_def mkt_stocks_assets stocks_of)
    then show ?thesis
      by (simp add: x  stocks Mkt coincides_on_def prices_of)
  qed
  have "prices ?res x = pr" by (simp add: prices_of)
 show ?thesis
   using ‹coincides_on Mkt (discrete_market_of (stocks Mkt) ((prices Mkt)(x := pr))) (stocks Mkt) ‹prices (discrete_market_of (stocks Mkt) ((prices Mkt)(x := pr))) x = pr x  stocks Mkt by blast
qed



lemma (in disc_market_pos_stock) arbitrage_portfolio_properties:
  assumes "price_structure der matur π pr"
  and "replicating_portfolio pf der matur"
  and  "(coincides_on Mkt Mkt2 (stocks Mkt))"
  and "(prices Mkt2 x = pr)"
  and "x stocks Mkt"
  and "diff_inv = (π - initial_value pf) / constant_image (prices Mkt pos_stock 0)"
  and "diff_inv  0"
  and "arb_pf = (λ (x::'b) (n::nat) (w::'a). 0::real)(x:= (λ n w. -1), pos_stock := (λ n w. diff_inv))"
  and "contr_pf = qty_sum arb_pf pf"
shows "self_financing Mkt2 contr_pf"
  and "trading_strategy contr_pf"
  and "w space M. cls_val_process Mkt2 contr_pf 0 w = 0"
  and "0 < diff_inv  (AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w)"
  and "diff_inv < 0  (AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w)"
  and "support_set arb_pf = {x, pos_stock}"
  and "portfolio contr_pf"
proof -
  have "0 < constant_image (prices Mkt pos_stock 0)" using trading_strategy_init
  proof -
    have "borel_adapt_stoch_proc F (prices Mkt pos_stock)" using pos_stock_borel_adapted by simp
    hence "c. wspace M. prices Mkt pos_stock 0 w = c" using  adapted_init[of "prices Mkt pos_stock"] by simp
    moreover have "w space M. 0 < prices Mkt pos_stock 0 w" using positive by simp
    ultimately show ?thesis using constant_image_pos by simp
  qed
  show "support_set arb_pf = {x, pos_stock}"
  proof -
    have "arb_pf = (λ (x::'b) (n::nat) (w::'a). 0::real)(x:= (λ n w. -1), pos_stock := (λ n w. diff_inv))"
      using arb_pf = (λ (x::'b) (n::nat) (w::'a). 0::real)(x:= (λ n w. -1), pos_stock := (λ n w. diff_inv)) .
    moreover have "n w. diff_inv  0" using assms by simp
    moreover have "x pos_stock" using x  stocks Mkt in_stock by auto
    ultimately show ?thesis by (simp add:two_component_support_set)
  qed
  hence "portfolio arb_pf" unfolding portfolio_def by simp
  have arb_vp:"n w. val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * diff_inv - pr n w"
  proof (intro allI)
    fix n w
    have "val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * (λ n w. diff_inv) n w + prices Mkt2 x n w * (λ n w. -1) n w"
    proof (rule two_component_val_process)
      show "x pos_stock" using x  stocks Mkt in_stock by auto
      show "arb_pf = (λx n w. 0)(x := λa b. - 1, pos_stock := λa b. diff_inv)" using assms by simp
      show "portfolio arb_pf" using ‹portfolio arb_pf by simp
      show "n w. - (1::real)  0" by simp
      show "n w. diff_inv  0" using assms by auto
    qed
    also have "... = prices Mkt2 pos_stock n w * diff_inv - pr n w" using ‹prices Mkt2 x = pr by simp
    finally show "val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * diff_inv - pr n w" .
  qed
  have "static_quantities arb_pf" unfolding static_quantities_def
  proof
    fix asset
    assume "asset  support_set arb_pf"
    thus "c. arb_pf asset = (λn w. c)"
    proof (cases "asset = x")
      case True
      thus ?thesis using assms by auto
    next
      case False
      hence "asset = pos_stock" using ‹support_set arb_pf = {x, pos_stock}
        using asset  support_set arb_pf by blast
      thus ?thesis using assms by auto
    qed
  qed
  hence "trading_strategy arb_pf"
    using ‹portfolio arb_pf portfolio_def static_quantities_trading_strat by blast
  have "self_financing Mkt2 arb_pf"
        by (simp add: static_portfolio_self_financing arb_pf = (λx n w. 0) (x := λn w. -1, pos_stock := λn w. diff_inv))
  hence arb_uvp: "n w. cls_val_process Mkt2 arb_pf n w = prices Mkt2 pos_stock n w * diff_inv - pr n w" using assms arb_vp
    by (simp add:self_financingE)
  show "portfolio contr_pf" using assms
      by (metis ‹support_set arb_pf = {x, pos_stock} replicating_portfolio_def
          finite.emptyI finite.insertI portfolio_def stock_portfolio_def sum_portfolio)
  have "support_set contr_pf  stocks Mkt  {x}"
  proof -
    have "support_set contr_pf  support_set arb_pf  support_set pf" using assms
      by (simp add:sum_support_set)
    moreover have "support_set arb_pf  stocks Mkt  {x}" using ‹support_set arb_pf = {x, pos_stock} in_stock by simp
    moreover have "support_set pf  stocks Mkt  {x}" using assms unfolding replicating_portfolio_def
      stock_portfolio_def by auto
    ultimately show ?thesis by auto
  qed
  show "self_financing Mkt2 contr_pf"
    proof -
    have "self_financing Mkt2 (qty_sum arb_pf pf)"
    proof (rule sum_self_financing)
      show "portfolio arb_pf"  using  ‹support_set arb_pf = {x, pos_stock} unfolding portfolio_def by auto
      show "portfolio pf" using assms unfolding replicating_portfolio_def stock_portfolio_def by auto
      show "self_financing Mkt2 pf" using coincides_on_self_financing
        (coincides_on Mkt Mkt2 (stocks Mkt)) (prices Mkt2 x = pr) assms(2)
        unfolding replicating_portfolio_def stock_portfolio_def  by blast
      show "self_financing Mkt2 arb_pf"
        by (simp add: static_portfolio_self_financing arb_pf = (λx n w. 0) (x := λn w. -1, pos_stock := λn w. diff_inv))
    qed
    thus ?thesis using assms by simp
  qed
  show "trading_strategy contr_pf"
  proof -
    have "trading_strategy (qty_sum arb_pf pf)"
    proof (rule sum_trading_strat)
      show "trading_strategy pf" using assms unfolding replicating_portfolio_def by simp
      show "trading_strategy arb_pf" using ‹trading_strategy arb_pf .
    qed
    thus ?thesis using assms by simp
  qed
  show "w space M. cls_val_process Mkt2 contr_pf 0 w = 0"
  proof
    fix w
    assume "w space M"
    have "cls_val_process Mkt2 contr_pf 0 w = cls_val_process Mkt2 arb_pf 0 w + cls_val_process Mkt2 pf 0 w"
      using sum_cls_val_process0[of arb_pf pf Mkt2]
      using ‹portfolio arb_pf assms replicating_portfolio_def stock_portfolio_def by blast
    also have "... = prices Mkt2 pos_stock 0 w * diff_inv - pr 0 w + cls_val_process Mkt2 pf 0 w" using arb_uvp by simp
    also have "... = constant_image (prices Mkt pos_stock 0) * diff_inv - pr 0 w + cls_val_process Mkt2 pf 0 w"
    proof -
      have f1: "prices Mkt pos_stock = prices Mkt2 pos_stock"
        using ‹coincides_on Mkt Mkt2 (stocks Mkt)  in_stock unfolding coincides_on_def by blast
      have "prices Mkt pos_stock 0 w = constant_image (prices Mkt pos_stock 0)"
        using w  space M adapted_init constant_imageI pos_stock_borel_adapted by blast
      then show ?thesis
        using f1 by simp
    qed
    also have "... = (π - initial_value pf) - pr 0 w + cls_val_process Mkt2 pf 0 w"
      using 0 < constant_image (prices Mkt pos_stock 0) assms by simp
    also have "... = (π - initial_value pf) - π + cls_val_process Mkt2 pf 0 w" using ‹price_structure der matur π pr
      price_structure_init[of der matur π pr] by (simp add: w  space M)
    also have "... = (π - initial_value pf) - π + (initial_value pf)" using initial_valueI assms unfolding replicating_portfolio_def
      using w  space M coincides_stocks_cls_val_process self_financingE readable
      by (metis (no_types, hide_lams) support_adapt_def stock_portfolio_def subsetCE)
    also have "... = 0" by simp
    finally show "cls_val_process Mkt2 contr_pf 0 w = 0" .
  qed
  show "0 < diff_inv  (AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w)"
  proof
    assume "0 < diff_inv"
    show "AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w"
    proof (rule AE_mp)
      have "AE w in M. prices Mkt2 x matur w = der w" using ‹price_structure der matur π pr ‹prices Mkt2 x = pr
        unfolding price_structure_def by auto
      moreover have "AE w in M. cls_val_process Mkt2 pf matur  w = der w" using assms coincides_stocks_cls_val_process[of Mkt pf Mkt2]
        ‹coincides_on Mkt Mkt2 (stocks Mkt) unfolding replicating_portfolio_def by auto
      ultimately show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w" by auto
      show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w  0 < cls_val_process Mkt2 contr_pf matur w"
      proof (rule AE_I2, rule impI)
        fix w
        assume "w space M"
        and "prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w"
        have "cls_val_process Mkt2 contr_pf matur w = cls_val_process Mkt2 arb_pf matur w + cls_val_process Mkt2 pf matur w"
          using sum_cls_val_process[of arb_pf pf Mkt2]
          ‹portfolio arb_pf assms replicating_portfolio_def stock_portfolio_def by blast
        also have "... = prices Mkt2 pos_stock matur w * diff_inv - pr matur w + cls_val_process Mkt2 pf matur w"
          using arb_uvp by simp
        also have "... = prices Mkt2 pos_stock matur w * diff_inv - prices Mkt2 x matur w + cls_val_process Mkt2 pf matur w"
          using ‹prices Mkt2 x = pr by simp
        also have "... = prices Mkt2 pos_stock matur w * diff_inv" using ‹prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w
          by simp
        also have "... > 0" using positive 0 < diff_inv
          by (metis ‹coincides_on Mkt Mkt2 (stocks Mkt) coincides_on_def in_stock mult_pos_pos)
        finally have "cls_val_process Mkt2 contr_pf matur w > 0".
        thus "0 < cls_val_process Mkt2 contr_pf matur w" by simp
      qed
    qed
  qed
  show "diff_inv < 0  (AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w)"
  proof
    assume "diff_inv < 0"
    show "AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w"
    proof (rule AE_mp)
      have "AE w in M. prices Mkt2 x matur w = der w" using ‹price_structure der matur π pr ‹prices Mkt2 x = pr
        unfolding price_structure_def by auto
      moreover have "AE w in M. cls_val_process Mkt2 pf matur  w = der w" using assms coincides_stocks_cls_val_process[of Mkt pf Mkt2]
        ‹coincides_on Mkt Mkt2 (stocks Mkt) unfolding replicating_portfolio_def by auto
      ultimately show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w" by auto
      show "AE w in M. prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w  0 > cls_val_process Mkt2 contr_pf matur w"
      proof (rule AE_I2, rule impI)
        fix w
        assume "w space M"
        and "prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w"
        have "cls_val_process Mkt2 contr_pf matur w = cls_val_process Mkt2 arb_pf matur w + cls_val_process Mkt2 pf matur w"
          using sum_cls_val_process[of arb_pf pf Mkt2]
          ‹portfolio arb_pf assms replicating_portfolio_def stock_portfolio_def by blast
        also have "... = prices Mkt2 pos_stock matur w * diff_inv - pr matur w + cls_val_process Mkt2 pf matur w"
          using arb_uvp by simp
        also have "... = prices Mkt2 pos_stock matur w * diff_inv - prices Mkt2 x matur w + cls_val_process Mkt2 pf matur w"
          using ‹prices Mkt2 x = pr by simp
        also have "... = prices Mkt2 pos_stock matur w * diff_inv" using ‹prices Mkt2 x matur w = cls_val_process Mkt2 pf matur w
          by simp
        also have "... < 0" using positive diff_inv < 0
          by (metis ‹coincides_on Mkt Mkt2 (stocks Mkt) coincides_on_def in_stock mult_pos_neg)
        finally have "cls_val_process Mkt2 contr_pf matur w < 0".
        thus "0 > cls_val_process Mkt2 contr_pf matur w" by simp
      qed
    qed
  qed
qed

lemma (in disc_equity_market) mult_comp_cls_val_process_measurable':
  assumes "cls_val_process Mkt2 pf n borel_measurable (F n)"
  and "portfolio pf"
  and "qty n  borel_measurable (F n)"
  and "0  n"
shows "cls_val_process Mkt2 (qty_mult_comp pf qty) n  borel_measurable (F n)"
proof -
  have "m. n = Suc m" using assms by presburger
  from this obtain m where "n = Suc m" by auto
  hence "cls_val_process Mkt2 (qty_mult_comp pf qty) (Suc m)  borel_measurable (F (Suc m))"
    using  mult_comp_cls_val_process_Suc[of pf Mkt2 qty] borel_measurable_times[of "cls_val_process Mkt2 pf (Suc m)" "F (Suc m)" "qty (Suc m)"]
      assms n= Suc m by presburger
  thus ?thesis using n = Suc m by simp
qed


lemma (in disc_equity_market) mult_comp_cls_val_process_measurable:
  assumes "n. cls_val_process Mkt2 pf n borel_measurable (F n)"
  and "portfolio pf"
  and "n. qty (Suc n)  borel_measurable (F n)"
shows "n. cls_val_process Mkt2 (qty_mult_comp pf qty) n  borel_measurable (F n)"
proof
  fix n
  show "cls_val_process Mkt2 (qty_mult_comp pf qty) n  borel_measurable (F n)"
  proof (cases "n=0")
    case False
    hence "m. n = Suc m" by presburger
    from this obtain m where "n = Suc m" by auto
    have "qty n  borel_measurable (F n)"
    using Suc_n_not_le_n n = Suc m assms(3) increasing_measurable_info nat_le_linear by blast
    hence "qty (Suc m)  borel_measurable (F (Suc m))" using n = Suc m by simp
    hence "cls_val_process Mkt2 (qty_mult_comp pf qty) (Suc m)  borel_measurable (F (Suc m))"
      using  mult_comp_cls_val_process_Suc[of pf Mkt2 qty] borel_measurable_times[of "cls_val_process Mkt2 pf (Suc m)" "F (Suc m)" "qty (Suc m)"]
        assms n= Suc m by presburger
    thus ?thesis using n = Suc m by simp
  next
    case True
    have "qty (Suc 0)  borel_measurable (F 0)" using assms by simp
    moreover have "cls_val_process Mkt2 pf 0  borel_measurable (F 0)" using assms  by simp
    ultimately have "(λw. cls_val_process Mkt2 pf 0 w * qty (Suc 0) w)  borel_measurable (F 0)" by simp
    thus ?thesis using assms(2) True mult_comp_cls_val_process0
      by (simp add: (λw. cls_val_process Mkt2 pf 0 w * qty (Suc 0) w)  borel_measurable (F 0) mult_comp_cls_val_process0 measurable_cong)
  qed
qed





lemma (in disc_equity_market) mult_comp_val_process_measurable:
  assumes "val_process Mkt2 pf n borel_measurable (F n)"
  and "portfolio pf"
  and "qty (Suc n)  borel_measurable (F n)"
shows "val_process Mkt2 (qty_mult_comp pf qty) n  borel_measurable (F n)"
  using  mult_comp_val_process[of pf Mkt2 qty] borel_measurable_times[of "val_process Mkt2 pf n" "F n" "qty (Suc n)"]
  assms by presburger

lemma (in disc_market_pos_stock) repl_fair_price_unique:
  assumes "replicating_portfolio pf der matur"
  and "fair_price Mkt π der matur"
shows "π = initial_value pf"
proof -
  have expr: "( pr. price_structure der matur π pr 
    ( x. (x stocks Mkt 
      ( Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt))  (prices Mkt2 x = pr)  portfolio p  support_set p  stocks Mkt  {x} 
        ¬ arbitrage_process Mkt2 p))))" using assms fair_priceI by simp
  then obtain pr where "price_structure der matur π pr" and
    xasset: "( x. (x stocks Mkt 
      ( Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt))  (prices Mkt2 x = pr)  portfolio p  support_set p  stocks Mkt  {x} 
        ¬ arbitrage_process Mkt2 p)))" by auto
  define diff_inv where "diff_inv = (π - initial_value pf) / constant_image (prices Mkt pos_stock 0)"
  {
    fix x
    assume "x stocks Mkt"
    hence mkprop: "( Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt))  (prices Mkt2 x = pr)  portfolio p  support_set p  stocks Mkt  {x} 
          ¬ arbitrage_process Mkt2 p)" using xasset by simp
    fix Mkt2
    assume "(coincides_on Mkt Mkt2 (stocks Mkt))" and "(prices Mkt2 x = pr)"
    have "0 < constant_image (prices Mkt pos_stock 0)" using trading_strategy_init
      proof -
        have "borel_adapt_stoch_proc F (prices Mkt pos_stock)" using pos_stock_borel_adapted by simp
        hence "c. wspace M. prices Mkt pos_stock 0 w = c" using  adapted_init[of "prices Mkt pos_stock"] by simp
        moreover have "w space M. 0 < prices Mkt pos_stock 0 w" using positive by simp
        ultimately show ?thesis using constant_image_pos by simp
      qed

    define arb_pf where "arb_pf = (λ (x::'b) (n::nat) (w::'a). 0::real)(x:= (λ n w. -1), pos_stock := (λ n w. diff_inv))"
    define contr_pf where "contr_pf = qty_sum arb_pf pf"
    have 1:"0  diff_inv  self_financing Mkt2 contr_pf"
      using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
      using  ‹coincides_on Mkt Mkt2 (stocks Mkt) ‹price_structure der matur π pr ‹prices Mkt2 x = pr
        x  stocks Mkt arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
    have 2:"0  diff_inv  trading_strategy contr_pf"
      using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
      using  ‹coincides_on Mkt Mkt2 (stocks Mkt) ‹price_structure der matur π pr ‹prices Mkt2 x = pr
        x  stocks Mkt arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
    have 3:"0  diff_inv  (w space M. cls_val_process Mkt2 contr_pf 0 w = 0)"
      using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
      using  ‹coincides_on Mkt Mkt2 (stocks Mkt) ‹price_structure der matur π pr ‹prices Mkt2 x = pr
        x  stocks Mkt arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
    have 4: "0 < diff_inv  (AE w in M. 0 < cls_val_process Mkt2 contr_pf matur w)"
      using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
      using  ‹coincides_on Mkt Mkt2 (stocks Mkt) ‹price_structure der matur π pr ‹prices Mkt2 x = pr
        x  stocks Mkt arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
    have 5: "diff_inv < 0  (AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w)"
      using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
      using  ‹coincides_on Mkt Mkt2 (stocks Mkt) ‹price_structure der matur π pr ‹prices Mkt2 x = pr
        x  stocks Mkt arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
    have 6: "0  diff_inv  support_set arb_pf = {x, pos_stock}"
      using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
      using  ‹coincides_on Mkt Mkt2 (stocks Mkt) ‹price_structure der matur π pr ‹prices Mkt2 x = pr
        x  stocks Mkt arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
    have 7: "0  diff_inv support_set contr_pf  stocks Mkt  {x}"
    proof -
      have "0  diff_inv  support_set contr_pf  support_set arb_pf  support_set pf" unfolding contr_pf_def
        by (simp add:sum_support_set)
      moreover have "0  diff_inv support_set arb_pf  stocks Mkt  {x}" using 0  diff_inv  support_set arb_pf = {x, pos_stock} in_stock by simp
      moreover have "0  diff_inv support_set pf  stocks Mkt  {x}" using assms unfolding replicating_portfolio_def
        stock_portfolio_def by auto
      ultimately show ?thesis by auto
    qed
    have 8:"0  diff_inv portfolio contr_pf"
      using arbitrage_portfolio_properties[of der matur π pr pf Mkt2 x diff_inv arb_pf contr_pf]
      using  ‹coincides_on Mkt Mkt2 (stocks Mkt) ‹price_structure der matur π pr ‹prices Mkt2 x = pr
        x  stocks Mkt arb_pf_def assms(1) contr_pf_def diff_inv_def by blast
    have 9: "0  diff_inv  cls_val_process Mkt2 contr_pf matur  borel_measurable (F matur)"
    proof
      assume "0  diff_inv"
      have 10:" asset  support_set arb_pf  support_set pf. prices Mkt2 asset matur  borel_measurable (F matur)"
      proof
        fix asset
        assume "asset  support_set arb_pf  support_set pf"
        show "prices Mkt2 asset matur  borel_measurable (F matur)"
        proof (cases "asset  support_set pf")
          case True
          thus ?thesis using assms readable
            by (metis (no_types, lifting)  ‹coincides_on Mkt Mkt2 (stocks Mkt) adapt_stoch_proc_def
                coincides_on_def disc_equity_market.replicating_portfolio_def
                disc_equity_market_axioms  stock_portfolio_def subsetCE)
        next
          case False
          hence "asset support_set arb_pf" using asset  support_set arb_pf  support_set pf by auto
          show ?thesis
          proof (cases "asset = x")
            case True
            thus ?thesis
              using ‹price_structure der matur π pr ‹prices Mkt2 x = pr price_structure_borel_measurable by blast
          next
            case False
            hence "asset = pos_stock" using asset support_set arb_pf 0  diff_inv  support_set arb_pf = {x, pos_stock}
              0  diff_inv by auto
            thus ?thesis
              by (metis ‹coincides_on Mkt Mkt2 (stocks Mkt) adapt_stoch_proc_def coincides_on_def in_stock pos_stock_borel_adapted)
          qed
        qed
      qed
      moreover have "assetsupport_set contr_pf. contr_pf asset matur  borel_measurable (F matur)"
        using 0  diff_inv trading_strategy contr_pf 0  diff_inv
        by (metis adapt_stoch_proc_def disc_filtr_prob_space.predict_imp_adapt disc_filtr_prob_space_axioms trading_strategy_def)
      ultimately show "cls_val_process Mkt2 contr_pf matur  borel_measurable (F matur)"
      proof-
        have "assetsupport_set contr_pf. contr_pf asset (Suc matur)  borel_measurable (F matur)"
           using 0  diff_inv trading_strategy contr_pf 0  diff_inv
           by (simp add: predict_stoch_proc_def trading_strategy_def)
         moreover have "assetsupport_set contr_pf. prices Mkt2 asset matur  borel_measurable (F matur)" using 10 unfolding contr_pf_def
           using sum_support_set[of arb_pf pf] by auto
         ultimately show ?thesis  by (metis (no_types, lifting) "1" 0  diff_inv quantity_adapted self_financingE)
      qed
    qed
    {
      assume "0 > diff_inv"
      define opp_pf where "opp_pf = qty_mult_comp contr_pf (λ n w. -1)"
      have "arbitrage_process Mkt2 opp_pf"
      proof (rule arbitrage_processI, rule exI, intro conjI)
        show "self_financing Mkt2 opp_pf" using 1 0 > diff_inv mult_time_constant_self_financing[of contr_pf] 8
          unfolding opp_pf_def by auto
        show "trading_strategy opp_pf" unfolding opp_pf_def
        proof (rule mult_comp_trading_strat)
          show "trading_strategy contr_pf" using 2 0 > diff_inv by auto
          show "borel_predict_stoch_proc F (λn w. - 1)" by (simp add: constant_process_borel_predictable)
        qed
        show "wspace M. cls_val_process Mkt2 opp_pf 0 w = 0"
        proof
          fix w
          assume "w space M"
          show "cls_val_process Mkt2 opp_pf 0 w = 0" using 3 8 0 > diff_inv
            using w  space M mult_comp_cls_val_process0 opp_pf_def by fastforce
        qed
        have "AE w in M. 0 < cls_val_process Mkt2 opp_pf matur w"
        proof (rule AE_mp)
          show "AE w in M. 0 > cls_val_process Mkt2 contr_pf matur w" using 5 0 > diff_inv by auto
          show "AE w in M. cls_val_process Mkt2 contr_pf matur w < 0  0 < cls_val_process Mkt2 opp_pf matur w"
          proof
            fix w
            assume "w space M"
            show "cls_val_process Mkt2 contr_pf matur w < 0  0 < cls_val_process Mkt2 opp_pf matur w"
            proof
              assume "cls_val_process Mkt2 contr_pf matur w < 0"
              show "0 < cls_val_process Mkt2 opp_pf matur w"
              proof (cases "matur = 0")
                case False
                hence "m. Suc m = matur" by presburger
                from this obtain m where "Suc m = matur" by auto
                hence "0 < cls_val_process Mkt2 opp_pf (Suc m) w" using 3 8 0 > diff_inv w  space M mult_comp_cls_val_process_Suc  opp_pf_def
                  using ‹cls_val_process Mkt2 contr_pf matur w < 0 by fastforce
                thus ?thesis using ‹Suc m = matur by simp
              next
                case True
                thus ?thesis using 3 8 0 > diff_inv w  space M mult_comp_cls_val_process0 opp_pf_def
                  using ‹cls_val_process Mkt2 contr_pf matur w < 0 by auto
              qed
            qed
          qed
        qed
        thus "AE w in M. 0  cls_val_process Mkt2 opp_pf matur w" by auto
        show "0 < prob {w  space M. 0 < cls_val_process Mkt2 opp_pf matur w}"
        proof -
          let ?P = "{w space M. 0 < cls_val_process Mkt2 opp_pf matur w}"
          have "cls_val_process Mkt2 opp_pf matur  borel_measurable (F matur)" (*unfolding opp_pf_def *)
          proof -
            have "cls_val_process Mkt2 contr_pf matur  borel_measurable (F matur)" using 9 0 > diff_inv by simp
            moreover have "portfolio contr_pf" using 8 0 > diff_inv by simp
            moreover have "(λw. - 1)  borel_measurable (F matur)" by (simp add:constant_process_borel_adapted)
            ultimately show ?thesis
              using mult_comp_cls_val_process_measurable
            proof -
              have "diff_inv  0"
                using diff_inv < 0 by blast
              then have "self_financing Mkt2 contr_pf"
                by (metis "1")
              then show ?thesis
                by (metis (no_types) (λw. - 1)  borel_measurable (F matur) ‹portfolio contr_pf
                    ‹self_financing Mkt2 opp_pf ‹cls_val_process Mkt2 contr_pf matur  borel_measurable (F matur)
                    mult_comp_val_process_measurable opp_pf_def self_financingE)
            qed
          qed
          moreover have "space M = space (F matur)"
            using filtration by (simp add: filtration_def subalgebra_def)
          ultimately have "?P  sets (F matur)" using borel_measurable_iff_greater[of "val_process Mkt2 contr_pf matur" "F matur"]
            by auto
          hence "?P  sets M" by (meson filtration filtration_def subalgebra_def subsetCE)
          hence "measure M ?P = 1" using  prob_Collect_eq_1[of "λx. 0 < cls_val_process Mkt2 opp_pf matur x"]
             AE w in M. 0 < cls_val_process Mkt2 opp_pf matur w 0 > diff_inv by blast
          thus ?thesis by simp
        qed
      qed
        have " p. portfolio p  support_set p  stocks Mkt  {x}  arbitrage_process Mkt2 p"
        proof(intro exI conjI)
          show "arbitrage_process Mkt2 opp_pf" using ‹arbitrage_process Mkt2 opp_pf .
          show "portfolio opp_pf" unfolding opp_pf_def using 8 0 > diff_inv by (auto simp add: mult_comp_portfolio)
          show "support_set opp_pf  stocks Mkt  {x}" unfolding opp_pf_def using 7 0 > diff_inv
            using mult_comp_support_set by fastforce
        qed
      } note negp = this
      {
        assume "0 < diff_inv"
        have "arbitrage_process Mkt2 contr_pf"
        proof (rule arbitrage_processI, rule exI, intro conjI)
          show "self_financing Mkt2 contr_pf" using 1 0 < diff_inv by auto
          show "trading_strategy contr_pf" using 2 0 < diff_inv by auto
          show "wspace M. cls_val_process Mkt2 contr_pf 0 w = 0" using 3 0 < diff_inv by auto
          show "AE w in M. 0  cls_val_process Mkt2 contr_pf matur w" using 4 0 < diff_inv by auto
          show "0 < prob {w  space M. 0 < cls_val_process Mkt2 contr_pf matur w}"
            proof -
              let ?P = "{w space M. 0 < cls_val_process Mkt2 contr_pf matur w}"
              have "cls_val_process Mkt2 contr_pf matur  borel_measurable (F matur)" using 9 0 < diff_inv by auto
              moreover have "space M = space (F matur)"
                using filtration  by (simp add: filtration_def subalgebra_def)
              ultimately have "?P  sets (F matur)" using borel_measurable_iff_greater[of "val_process Mkt2 contr_pf matur" "F matur"]
                by auto
              hence "?P  sets M" by (meson filtration filtration_def subalgebra_def subsetCE)
              hence "measure M ?P = 1" using  prob_Collect_eq_1[of "λx. 0 < cls_val_process Mkt2 contr_pf matur x"]
                 4 0 < diff_inv by blast
              thus ?thesis by simp
            qed
          qed
          have " p. portfolio p  support_set p  stocks Mkt  {x}  arbitrage_process Mkt2 p"
          proof(intro exI conjI)
            show "arbitrage_process Mkt2 contr_pf" using ‹arbitrage_process Mkt2 contr_pf .
            show "portfolio contr_pf" using 8 0 < diff_inv by auto
            show "support_set contr_pf  stocks Mkt  {x}" using 7 0 < diff_inv by auto
          qed
      } note posp = this
      have "diff_inv  0  ¬( pr. price_structure der matur π pr 
        ( x. (x stocks Mkt 
          ( Mkt2 p. (coincides_on Mkt Mkt2 (stocks Mkt))  (prices Mkt2 x = pr)  portfolio p  support_set p  stocks Mkt  {x} 
            ¬ arbitrage_process Mkt2 p))))"
        using ‹coincides_on Mkt Mkt2 (stocks Mkt) ‹prices Mkt2 x = pr x  stocks Mkt xasset posp negp by force
  }
  hence "diff_inv = 0" using fix_asset_price expr by metis
  moreover have "constant_image (prices Mkt pos_stock 0) > 0"
    by (simp add: adapted_init constant_image_pos pos_stock_borel_adapted positive)
  ultimately show ?thesis unfolding diff_inv_def by auto
qed


subsection ‹Risk-neutral probability space›

subsubsection ‹risk-free rate and discount factor processes›

fun disc_rfr_proc:: "real  nat  'a  real"
where
  rfr_base: "(disc_rfr_proc r) 0 w = 1"|
  rfr_step: "(disc_rfr_proc r) (Suc n) w = (1+r) * (disc_rfr_proc r) n w"


lemma disc_rfr_proc_borel_measurable:
  shows "(disc_rfr_proc r) n  borel_measurable M"
proof (induct n)
case (Suc n) thus ?case by (simp add:borel_measurable_times)
qed auto

lemma disc_rfr_proc_nonrandom:
  fixes r::real
  shows "n. disc_rfr_proc r n  borel_measurable (F 0)" using disc_rfr_proc_borel_measurable by auto


lemma (in disc_equity_market) disc_rfr_constant_time:
shows "c. w  space (F 0).  (disc_rfr_proc r n) w = c"
proof (rule triv_measurable_cst)
  show "space (F 0) = space M" using filtration by (simp add:filtration_def subalgebra_def)
  show "sets (F 0) = {{}, space M}" using info_disc_filtr  by (simp add: bot_nat_def init_triv_filt_def)
  show "(disc_rfr_proc r n)  borel_measurable (F 0)" using disc_rfr_proc_nonrandom by blast
  show "space M  {}" by (simp add:not_empty)
qed



lemma (in disc_filtr_prob_space) disc_rfr_proc_borel_adapted:
  shows "borel_adapt_stoch_proc F (disc_rfr_proc r)"
unfolding adapt_stoch_proc_def using disc_rfr_proc_nonrandom
         filtration unfolding filtration_def
  by (meson increasing_measurable_info le0)



lemma disc_rfr_proc_positive:
  assumes "-1 < r"
  shows "n w . 0 < disc_rfr_proc r n w"
proof -
  fix n
  fix w::'a
  show "0 < disc_rfr_proc r n w"
  proof (induct n)
  case 0 thus ?case using assms  "disc_rfr_proc.simps" by simp
  next
  case (Suc n) thus ?case using  assms "disc_rfr_proc.simps" by simp
  qed
qed





lemma (in prob_space) disc_rfr_constant_time_pos:
  assumes "-1 < r"
shows "c > 0. w  space M.  (disc_rfr_proc r n) w = c"
proof -
  let ?F = "sigma (space M) {{}, space M}"
  have  ex: "c. w  space ?F.  (disc_rfr_proc r n) w = c"
  proof (rule triv_measurable_cst)
    show "space ?F = space M" by simp
    show "sets ?F = {{}, space M}" by (meson sigma_algebra.sets_measure_of_eq sigma_algebra_trivial)
    show "(disc_rfr_proc r n)  borel_measurable ?F" using disc_rfr_proc_borel_measurable by blast
    show "space M  {}" by (simp add:not_empty)
  qed
  from this obtain c where "w  space ?F.  (disc_rfr_proc r n) w = c" by auto note cprops = this
  have "c>0"
  proof -
    have " w. w space M" using subprob_not_empty by blast
    from this obtain w where "w space M" by auto
    hence "c = disc_rfr_proc r n w" using cprops  by simp
    also have "... > 0" using disc_rfr_proc_positive[of r n] assms by simp
    finally show ?thesis .
  qed
  moreover have "space M = space ?F" by simp
  ultimately show ?thesis using ex using cprops by blast
qed


lemma  disc_rfr_proc_Suc_div:
  assumes "-1 < r"
  shows "w. disc_rfr_proc r (Suc n) w/disc_rfr_proc r n w = 1+r"
proof -
  fix w::'a
  show "disc_rfr_proc r (Suc n) w/disc_rfr_proc r n w = 1+r"
    using disc_rfr_proc_positive assms by (metis rfr_step  less_irrefl nonzero_eq_divide_eq)
qed

definition discount_factor where
  "discount_factor r n = (λw. inverse (disc_rfr_proc r n w))"

lemma discount_factor_times_rfr:
  assumes "-1 < r"
  shows "(1+r) * discount_factor r (Suc n) w = discount_factor r n w" unfolding discount_factor_def using assms by simp

lemma discount_factor_borel_measurable:
  shows "discount_factor r n  borel_measurable M" unfolding discount_factor_def
proof (rule borel_measurable_inverse)
  show "disc_rfr_proc r n  borel_measurable M" by (simp add:disc_rfr_proc_borel_measurable)
qed

lemma discount_factor_init:
  shows "discount_factor r 0 = (λw. 1)" unfolding discount_factor_def by simp

lemma discount_factor_nonrandom:
  shows "discount_factor r n  borel_measurable M" unfolding discount_factor_def
proof (rule borel_measurable_inverse)
  show "disc_rfr_proc r n  borel_measurable M" by (simp add:disc_rfr_proc_borel_measurable)
qed


lemma discount_factor_positive:
  assumes "-1 < r"
  shows "n w . 0 < discount_factor r n w" using assms disc_rfr_proc_positive unfolding discount_factor_def by auto


lemma (in prob_space) discount_factor_constant_time_pos:
  assumes "-1 < r"
shows "c > 0. w  space M.  (discount_factor r n) w = c"  using  disc_rfr_constant_time_pos unfolding discount_factor_def
  by (metis assms inverse_positive_iff_positive)


locale rsk_free_asset =
  fixes Mkt r risk_free_asset
  assumes acceptable_rate: "-1 < r"
  and rf_price: "prices Mkt risk_free_asset = disc_rfr_proc r"
  and rf_stock: "risk_free_asset  stocks Mkt"

locale rfr_disc_equity_market = disc_equity_market   + rsk_free_asset +
  assumes rd: " asset stocks Mkt. borel_adapt_stoch_proc F (prices Mkt asset)"



sublocale rfr_disc_equity_market  disc_market_pos_stock _ _ _ "risk_free_asset"
by (unfold_locales, (auto simp add: rf_stock rd disc_rfr_proc_positive rf_price acceptable_rate))

subsubsection ‹Discounted value of a stochastic process›

definition discounted_value where
  "discounted_value r X = (λ n w. discount_factor r n w * X n w)"



lemma (in rfr_disc_equity_market) discounted_rfr:
  shows "discounted_value r (prices Mkt risk_free_asset) n w = 1" unfolding discounted_value_def discount_factor_def
  using rf_price by (metis less_irrefl mult.commute positive right_inverse)

lemma  discounted_init:
  shows "w. discounted_value r X 0 w = X 0 w" unfolding discounted_value_def by (simp add: discount_factor_init)

lemma  discounted_mult:
  shows "n w. discounted_value r (λm x. X m x * Y m x) n w = X n w * (discounted_value r Y) n w"
  by (simp add: discounted_value_def)

lemma  discounted_mult':
  shows "discounted_value r (λm x. X m x * Y m x) n w = X n w * (discounted_value r Y) n w"
  by (simp add: discounted_value_def)

lemma discounted_mult_times_rfr:
  assumes "-1 < r"
  shows "discounted_value r (λm w. (1+r) * X w) (Suc n) w = discounted_value r (λm w. X w) n w"
    unfolding discounted_value_def using assms discount_factor_times_rfr discounted_mult
    by (simp add: discount_factor_times_rfr mult.commute)

lemma discounted_cong:
  assumes "n w. X n w = Y n w"
  shows " n w. discounted_value r X n w = discounted_value r Y n w"
  by (simp add: assms discounted_value_def)

lemma  discounted_cong':
  assumes "X n w = Y n w"
  shows "discounted_value r X n w = discounted_value r Y n w"
  by (simp add: assms discounted_value_def)

lemma discounted_AE_cong:
  assumes "AE w in N. X n w = Y n w"
  shows "AE w in N. discounted_value r X n w = discounted_value r Y n w"
proof (rule AE_mp)
  show "AE w in N. X n w = Y n w" using assms by simp
  show "AE w in N. X n w = Y n w  discounted_value r X n w = discounted_value r Y n w"
  proof
    fix w
    assume "w space N"
    thus "X n w = Y n w  discounted_value r X n w = discounted_value r Y n w " by (simp add:discounted_value_def)
  qed
qed



lemma discounted_sum:
  assumes "finite I"
shows "n w. ( i I. (discounted_value r (λm x. f i m x)) n w) = (discounted_value r (λm x. (i I. f i m x)) n w)"
  using assms(1) subset_refl[of I]
proof (induct rule: finite_subset_induct)
  case empty
  then show ?case
    by (simp add: discounted_value_def)
next
  case (insert a F)
  show ?case
  proof (intro allI)
    fix n w
    have "(iinsert a F. discounted_value r (f i) n w) = discounted_value r (f a) n w + (iF. discounted_value r (f i) n w)"
      by (simp add: insert.hyps(1) insert.hyps(3))
    also have "... = discounted_value r (f a) n w + discounted_value r (λm x. iF. f i m x) n w" using insert.hyps(4) by simp
    also have "... = discounted_value r (λm x. iinsert a F. f i m x) n w"
      by (simp add: discounted_value_def insert.hyps(1) insert.hyps(3) ring_class.ring_distribs(1))
    finally show "(iinsert a F. discounted_value r (f i) n w) = discounted_value r (λm x. iinsert a F. f i m x) n w" .
  qed
qed

lemma  discounted_adapted:
  assumes "borel_adapt_stoch_proc F X"
  shows "borel_adapt_stoch_proc F (discounted_value r X)" unfolding adapt_stoch_proc_def
proof
  fix t
  show "discounted_value r X t  borel_measurable (F t)" unfolding discounted_value_def
  proof (rule borel_measurable_times)
    show "X t  borel_measurable (F t)" using assms unfolding adapt_stoch_proc_def by simp
    show "discount_factor r t  borel_measurable (F t)" using discount_factor_borel_measurable by auto
  qed
qed

lemma discounted_measurable:
  assumes "X borel_measurable N"
  shows "discounted_value r (λm. X) m  borel_measurable N" unfolding discounted_value_def
proof (rule borel_measurable_times)
  show "X borel_measurable N" using assms by simp
  show "discount_factor r m  borel_measurable N" using discount_factor_borel_measurable by auto
qed


lemma (in prob_space) discounted_integrable:
  assumes "integrable N (X n)"
  and "-1 < r"
  and "space N = space M"
  shows "integrable N (discounted_value r X n)" unfolding discounted_value_def
proof -
  have "c> 0. w  space M.  (discount_factor r n) w = c" using discount_factor_constant_time_pos assms by simp
  from this obtain c where "c > 0" and "w  space M.  (discount_factor r n) w = c" by auto note cprops = this
  hence "w  space M. discount_factor r n w = c" using cprops  by simp
  hence "w  space N. discount_factor r n w = c" using assms by simp
  thus "integrable N (λw. discount_factor r n w * X n w)"
    using w  space N. discount_factor r n w = c assms
    integrable_cong[of N N "(λw. discount_factor r n w * X n w)" "(λw. c * X n w)"] by simp
qed


subsubsection ‹Results on risk-neutral probability spaces›

definition (in rfr_disc_equity_market) risk_neutral_prob where
  "risk_neutral_prob N  (prob_space N)  ( asset  stocks Mkt. martingale N F (discounted_value r (prices Mkt asset)))"


lemma integrable_val_process:
  assumes " asset  support_set pf. integrable M (λw. prices Mkt asset n w * pf asset (Suc n) w)"
  shows "integrable M (val_process Mkt pf n)"
proof (cases "portfolio pf")
  case False
  thus ?thesis unfolding val_process_def by simp
next
  case True
  hence "val_process Mkt pf n = (λw. xsupport_set pf. prices Mkt x n w * pf x (Suc n) w)"
    unfolding val_process_def by simp
  moreover have "integrable M (λw. xsupport_set pf. prices Mkt x n w * pf x (Suc n) w)" using assms by simp
  ultimately show ?thesis by simp
qed

lemma integrable_self_fin_uvp:
  assumes " asset  support_set pf. integrable M (λw. prices Mkt asset n w * pf asset (Suc n) w)"
  and "self_financing Mkt pf"
shows "integrable M (cls_val_process Mkt pf n)"
proof -
  have "val_process Mkt pf n = cls_val_process Mkt pf n" using assms by (simp add:self_financingE)
  moreover have "integrable M (val_process Mkt pf n)" using assms by (simp add:integrable_val_process)
  ultimately show ?thesis by simp
qed



lemma (in rfr_disc_equity_market) stocks_portfolio_risk_neutral:
  assumes "risk_neutral_prob N"
  and "trading_strategy pf"
  and "subalgebra N M"
  and "support_set pf  stocks Mkt"
  and "n.  asset  support_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
  shows  "x  support_set pf. AE w in N.
        (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n))) w =
        discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w"
proof
  have nsigfin: "n. sigma_finite_subalgebra N (F n)" using assms unfolding risk_neutral_prob_def martingale_def subalgebra_def
      using filtration filtration_def risk_neutral_prob_def prob_space.subalgebra_sigma_finite in_stock by metis
  have "disc_filtr_prob_space N F"
  proof -
    have "prob_space N" using assms unfolding risk_neutral_prob_def by simp
    moreover have "disc_filtr N F" using assms subalgebra_filtration
      by (metis (no_types, lifting) filtration disc_filtr_def filtration_def)
    ultimately show ?thesis
      by (simp add: disc_filtr_prob_space_axioms_def disc_filtr_prob_space_def)
  qed
  fix asset
  assume "asset  support_set pf"
  hence "asset  stocks Mkt" using assms by auto
  have "discounted_value r (prices Mkt asset) (Suc n)  borel_measurable M" using assms readable
    by (meson asset  stocks Mkt borel_adapt_stoch_proc_borel_measurable discounted_adapted
        rfr_disc_equity_market.risk_neutral_prob_def rfr_disc_equity_market_axioms)
  hence b: "discounted_value r (prices Mkt asset) (Suc n)  borel_measurable N"
      using assms Conditional_Expectation.measurable_from_subalg[of N M _ borel] by auto
  show "AEeq N (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n)))
  (discounted_value r (λm y. prices Mkt asset m y * pf asset (Suc m) y) n)"
  proof -
    have "AE w in N. (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n))) w =
      (real_cond_exp N (F n) (λz. pf asset (Suc n) z * discounted_value r (λm y. prices Mkt asset m y) (Suc n) z)) w"
    proof (rule sigma_finite_subalgebra.real_cond_exp_cong)
      show "sigma_finite_subalgebra N (F n)" using nsigfin ..
      show "AE w in N. discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n) w =
         pf asset (Suc n) w * discounted_value r (λm y. prices Mkt asset m y) (Suc n) w"
        by (simp add: discounted_value_def)
      show "discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n)  borel_measurable N"
      proof -
        have "(λy. prices Mkt asset (Suc n) y * pf asset (Suc n) y)  borel_measurable N"
          using assms asset support_set pf by (simp add:borel_measurable_integrable)
        thus ?thesis unfolding discounted_value_def using discount_factor_borel_measurable[of r "Suc n" N] by simp
      qed
      show "(λz. pf asset (Suc n) z * discounted_value r (prices Mkt asset) (Suc n) z)  borel_measurable N"
      proof -
        have "pf asset (Suc n)  borel_measurable M" using assms asset support_set pf unfolding trading_strategy_def
          using borel_predict_stoch_proc_borel_measurable[of "pf asset"] by auto
        hence a: "pf asset (Suc n)  borel_measurable N" using assms Conditional_Expectation.measurable_from_subalg[of N M _ borel] by blast
        show ?thesis using a b by simp
      qed
    qed
    also have "AE w in N. (real_cond_exp N (F n) (λz. pf asset (Suc n) z * discounted_value r (λm y. prices Mkt asset m y) (Suc n) z)) w =
      pf asset (Suc n) w * (real_cond_exp N (F n) (λz. discounted_value r (λm y. prices Mkt asset m y) (Suc n) z)) w"
    proof (rule sigma_finite_subalgebra.real_cond_exp_mult)
      show "discounted_value r (prices Mkt asset) (Suc n)  borel_measurable N" using b by simp
      show "sigma_finite_subalgebra N (F n)" using nsigfin ..
      show "pf asset (Suc n)  borel_measurable (F n)" using assms asset support_set pf unfolding trading_strategy_def
          predict_stoch_proc_def by auto
      show "integrable N (λz. pf asset (Suc n) z * discounted_value r (prices Mkt asset) (Suc n) z)"
      proof -
        have "integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)" using assms asset  support_set pf by auto
        hence "integrable N (discounted_value r (λm w. prices Mkt asset m w * pf asset m w) (Suc n))" using assms
          unfolding risk_neutral_prob_def using acceptable_rate  by (auto simp add:discounted_integrable subalgebra_def)
        thus ?thesis using discounted_mult
            integrable_cong[of N N "discounted_value r (λm w. prices Mkt asset m w * pf asset m w) (Suc n)" "(λz. pf asset (Suc n) z * discounted_value r (prices Mkt asset) (Suc n) z)"]
          by (simp add: discounted_value_def)
      qed
    qed
    also have "AE w in N.  pf asset (Suc n) w * (real_cond_exp N (F n) (λz. discounted_value r (λm y. prices Mkt asset m y) (Suc n) z)) w =
            pf asset (Suc n) w * discounted_value r (λm y. prices Mkt asset m y) n w"
    proof -
      have "AEeq N (real_cond_exp N (F n) (λz. discounted_value r (λm y. prices Mkt asset m y) (Suc n) z))
        (λz. discounted_value r (λm y. prices Mkt asset m y) n z)"
      proof -
        have "martingale N F (discounted_value r (prices Mkt asset))"
          using assms asset  stocks Mkt unfolding risk_neutral_prob_def by simp
        moreover have "filtrated_prob_space N F" using ‹disc_filtr_prob_space N F
          using assms(2) disc_filtr_prob_space.axioms(1) filtrated_prob_space.intro filtrated_prob_space_axioms.intro filtration prob_space_axioms
          by (metis assms(3) subalgebra_filtration)
        ultimately show ?thesis using martingaleAE[of N F "discounted_value r (prices Mkt asset)" n "Suc n"] assms
          by simp
      qed
      thus ?thesis by auto
    qed
    also have "AE w in N.  pf asset (Suc n) w * discounted_value r (λm y. prices Mkt asset m y) n w =
      discounted_value r (λm y. pf asset (Suc m) y * prices Mkt asset m y) n w" by (simp add: discounted_value_def)
    also have "AE w in N. discounted_value r (λm y. pf asset (Suc m) y * prices Mkt asset m y) n w =
      discounted_value r (λm y. prices Mkt asset m y * pf asset (Suc m) y) n w"
      by (simp add: discounted_value_def)
    finally show "AE w in N.
      (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n))) w =
      (λx. discounted_value r (λm y. prices Mkt asset m y * pf asset (Suc m) y) n x) w" .
  qed
qed



lemma (in rfr_disc_equity_market) self_fin_trad_strat_mart:
  assumes "risk_neutral_prob N"
  and "filt_equiv F M N"
  and "trading_strategy pf"
  and "self_financing Mkt pf"
and "stock_portfolio Mkt pf"
  and "n.  asset  support_set pf. integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
  and "n.  asset  support_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
shows "martingale N F (discounted_value r (cls_val_process Mkt pf))" (*unfolding martingale_def*)
proof (rule disc_martingale_charact)
  show nsigfin: "n. sigma_finite_subalgebra N (F n)" using filt_equiv_prob_space_subalgebra assms
          using filtration filtration_def risk_neutral_prob_def subalgebra_sigma_finite by fastforce
  show "filtration N F" using assms by (simp  add:filt_equiv_filtration)
  have "borel_adapt_stoch_proc F (discounted_value r (cls_val_process Mkt pf))" using assms discounted_adapted
    cls_val_process_adapted[of pf] stock_portfolio_def
    by (metis (mono_tags, hide_lams) support_adapt_def readable subsetCE)
  thus "m. discounted_value r (cls_val_process Mkt pf) m  borel_measurable (F m)" unfolding adapt_stoch_proc_def by simp
  show "t. integrable N (discounted_value r (cls_val_process Mkt pf) t)"
  proof
    fix t
    have "integrable N (cls_val_process Mkt pf t)" using assms by (simp add: integrable_self_fin_uvp)
    thus "integrable N (discounted_value r (cls_val_process Mkt pf) t)" using assms discounted_integrable acceptable_rate
      by (metis filt_equiv_space)
  qed
  show "n. AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
                   discounted_value r (cls_val_process Mkt pf) n w"
  proof
    fix n
    show "AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
                    discounted_value r (cls_val_process Mkt pf) n w"
    proof -
      {
        fix w
        assume "w space M"
        have "discounted_value r (cls_val_process Mkt pf) (Suc n) w =
                  discount_factor r (Suc n) w * (xsupport_set pf. prices Mkt x (Suc n) w * pf x (Suc n) w)"
          unfolding discounted_value_def cls_val_process_def using assms unfolding trading_strategy_def by simp
        also have "... = (xsupport_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)"
          by (metis (no_types, lifting) mult.assoc sum.cong sum_distrib_left)
        finally have "discounted_value r (cls_val_process Mkt pf) (Suc n) w =
                  (xsupport_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)" .
      }
      hence space: "w space M. discounted_value r (cls_val_process Mkt pf) (Suc n) w =
                (xsupport_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)" by simp
      hence nspace: "w space N. discounted_value r (cls_val_process Mkt pf) (Suc n) w =
                (xsupport_set pf. discount_factor r (Suc n) w * prices Mkt x (Suc n) w * pf x (Suc n) w)" using assms by (simp add:filt_equiv_space)
      have sup_disc: "x  support_set pf. AE w in N.
        (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n))) w =
        discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w" using assms
        by (simp add:stocks_portfolio_risk_neutral filt_equiv_imp_subalgebra stock_portfolio_def)
      have "AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
                real_cond_exp N (F n) (λy. xsupport_set pf. discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n) y) w"
      proof (rule sigma_finite_subalgebra.real_cond_exp_cong')
        show "sigma_finite_subalgebra N (F n)" using nsigfin ..
        show "wspace N. discounted_value r (cls_val_process Mkt pf) (Suc n) w =
          (λy. xsupport_set pf. discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n) y) w"  using nspace
          by (metis (no_types, lifting) discounted_value_def mult.assoc sum.cong)
        show "(discounted_value r (cls_val_process Mkt pf) (Suc n))  borel_measurable N" using assms
          using t. integrable N (discounted_value r (cls_val_process Mkt pf) t) by blast
      qed
      also have "AE w in N. real_cond_exp N (F n)
        (λy. xsupport_set pf. discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n) y) w =
        (x support_set pf. (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n))) w)"
      proof (rule sigma_finite_subalgebra.real_cond_exp_bsum)
        show "sigma_finite_subalgebra N (F n)" using filt_equiv_prob_space_subalgebra assms
          using filtration filtration_def risk_neutral_prob_def subalgebra_sigma_finite by fastforce
        fix asset
        assume "asset  support_set pf"
        show "integrable N (discounted_value r (λm y. prices Mkt asset m y * pf asset m y) (Suc n))"
        proof (rule discounted_integrable)
          show "integrable N (λy. prices Mkt asset (Suc n) y * pf asset (Suc n) y)" using assms asset support_set pf by simp
          show "space N = space M" using assms by (metis filt_equiv_space)
          show "-1 < r" using acceptable_rate by simp
        qed
      qed
      also have "AE w in N.
        (x support_set pf. (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n))) w) =
        (x support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w)"
      proof (rule AE_sum)
        show "finite (support_set pf)" using assms(3) portfolio_def trading_strategy_def by auto
        show  "x  support_set pf. AE w in N.
        (real_cond_exp N (F n) (discounted_value r (λm y. prices Mkt x m y * pf x m y) (Suc n))) w =
        discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w" using sup_disc by simp
      qed
      also have "AE w in N.
        (x support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w) =
        discounted_value r (cls_val_process Mkt pf) n w"
      proof
        fix w
        assume "w space N"
        have "(x support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w) =
          discounted_value r (λm y. (x support_set pf. prices Mkt x m y * pf x (Suc m) y)) n w" using discounted_sum
          assms(3) portfolio_def trading_strategy_def by (simp add: discounted_value_def sum_distrib_left)
        also have "... = discounted_value r (val_process Mkt pf) n w"  unfolding val_process_def
          by (simp add: portfolio_def)
        also have "... = discounted_value r (cls_val_process Mkt pf) n w" using assms
          by (simp add:self_financingE discounted_cong)
        finally show "(x support_set pf. discounted_value r (λm y. prices Mkt x m y * pf x (Suc m) y) n w) =
          discounted_value r (cls_val_process Mkt pf) n w" .
      qed
      finally show "AE w in N. real_cond_exp N (F n) (discounted_value r (cls_val_process Mkt pf) (Suc n)) w =
        discounted_value r (cls_val_process Mkt pf) n w" .
    qed
  qed
qed

lemma (in disc_filtr_prob_space) finite_integrable_vp:
  assumes "n.  asset  support_set pf. finite (prices Mkt asset n `(space M))"
  and "n.  asset  support_set pf. finite (pf asset n `(space M))"
and "prob_space N"
  and "filt_equiv F M N"
and "trading_strategy pf"
and "n.  asset  support_set pf. prices Mkt asset n  borel_measurable M"
shows  "n. assetsupport_set pf. integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
proof (intro allI ballI)
  fix n
  fix asset
  assume "assetsupport_set pf"
  show "integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
  proof (rule prob_space.finite_borel_measurable_integrable)
    show "prob_space N" using assms by simp
    have "finite ((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M)"
    proof -
      have "y prices Mkt asset n `(space M). finite ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)"
        by (metis asset  support_set pf assms(2) finite_imageI image_image)
      hence "finite ( y prices Mkt asset n `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y))"
        using asset  support_set pf assms by blast
      moreover have "( y prices Mkt asset n `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)) =
        ( y prices Mkt asset n `(space M). (λw. y * pf asset (Suc n) w) ` space M)"  by simp
      moreover have "((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M) 
        ( y prices Mkt asset n `(space M). (λw. y * pf asset (Suc n) w) ` space M)"
      proof
        fix x
        assume "x  (λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M"
        show "x  (yprices Mkt asset n ` space M. (λw. y * pf asset (Suc n) w) ` space M)"
          using x  (λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M by auto
      qed
      ultimately show ?thesis by (simp add:finite_subset)
    qed
    thus "finite ((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
    have "(λw. prices Mkt asset n w * pf asset (Suc n) w)  borel_measurable M"
    proof -
      have "prices Mkt asset n  borel_measurable M" using assms asset  support_set pf by simp
      moreover have "pf asset (Suc n)  borel_measurable M" using assms unfolding trading_strategy_def
        using asset  support_set pf borel_predict_stoch_proc_borel_measurable by blast
      ultimately show ?thesis by simp
    qed
    thus "(λw. prices Mkt asset n w * pf asset (Suc n) w)  borel_measurable N" using assms by (simp add:filt_equiv_measurable)
  qed
qed


lemma (in disc_filtr_prob_space) finite_integrable_uvp:
  assumes "n.  asset  support_set pf. finite (prices Mkt asset n `(space M))"
  and "n.  asset  support_set pf. finite (pf asset n `(space M))"
and "prob_space N"
  and "filt_equiv F M N"
and "trading_strategy pf"
and "n.  asset  support_set pf. prices Mkt asset n  borel_measurable M"
shows  "n. assetsupport_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
proof (intro allI ballI)
  fix n
  fix asset
  assume "assetsupport_set pf"
  show "integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
  proof (rule prob_space.finite_borel_measurable_integrable)
    show "prob_space N" using assms by simp
    have "finite ((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M)"
    proof -
      have "y prices Mkt asset (Suc n) `(space M). finite ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)"
        by (metis asset  support_set pf assms(2) finite_imageI image_image)
      hence "finite ( y prices Mkt asset (Suc n) `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y))"
        using asset  support_set pf assms by blast
      moreover have "( y prices Mkt asset (Suc n) `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)) =
        ( y prices Mkt asset (Suc n) `(space M). (λw. y * pf asset (Suc n) w) ` space M)"  by simp
      moreover have "((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M) 
        ( y prices Mkt asset (Suc n) `(space M). (λw. y * pf asset (Suc n) w) ` space M)"
      proof
        fix x
        assume "x  (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M"
        show "x  (yprices Mkt asset (Suc n) ` space M. (λw. y * pf asset (Suc n) w) ` space M)"
          using x  (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M by auto
      qed
      ultimately show ?thesis by (simp add:finite_subset)
    qed
    thus "finite ((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
    have "(λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)  borel_measurable M"
    proof -
      have "prices Mkt asset (Suc n)  borel_measurable M" using assms
        using asset  support_set pf borel_adapt_stoch_proc_borel_measurable by blast
      moreover have "pf asset (Suc n)  borel_measurable M" using assms unfolding trading_strategy_def
        using asset  support_set pf borel_predict_stoch_proc_borel_measurable by blast
      ultimately show ?thesis by simp
    qed
    thus "(λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)  borel_measurable N" using assms by (simp add:filt_equiv_measurable)
  qed
qed

lemma (in rfr_disc_equity_market) self_fin_trad_strat_mart_finite:
  assumes "risk_neutral_prob N"
  and "filt_equiv F M N"
  and "trading_strategy pf"
  and "self_financing Mkt pf"
  and "support_set pf  stocks Mkt"
  and "n.  asset  support_set pf. finite (prices Mkt asset n `(space M))"
  and "n.  asset  support_set pf. finite (pf asset n `(space M))"
and " asset stocks Mkt. borel_adapt_stoch_proc F (prices Mkt asset)"
shows "martingale N F (discounted_value r (cls_val_process Mkt pf))"
proof (rule self_fin_trad_strat_mart, (simp add:assms)+)
  show "n. assetsupport_set pf. integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
  proof (intro allI ballI)
    fix n
    fix asset
    assume "assetsupport_set pf"
    show "integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
    proof (rule prob_space.finite_borel_measurable_integrable)
      show "prob_space N" using assms unfolding risk_neutral_prob_def by auto
      have "finite ((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M)"
      proof -
        have "y prices Mkt asset n `(space M). finite ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)"
          by (metis asset  support_set pf assms(7) finite_imageI image_image)
        hence "finite ( y prices Mkt asset n `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y))"
          using asset  support_set pf assms(6) by blast
        moreover have "( y prices Mkt asset n `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)) =
          ( y prices Mkt asset n `(space M). (λw. y * pf asset (Suc n) w) ` space M)"  by simp
        moreover have "((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M) 
          ( y prices Mkt asset n `(space M). (λw. y * pf asset (Suc n) w) ` space M)"
        proof
          fix x
          assume "x  (λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M"
          show "x  (yprices Mkt asset n ` space M. (λw. y * pf asset (Suc n) w) ` space M)"
            using x  (λw. prices Mkt asset n w * pf asset (Suc n) w) ` space M by auto
        qed
        ultimately show ?thesis by (simp add:finite_subset)
      qed
      thus "finite ((λw. prices Mkt asset n w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
      have "(λw. prices Mkt asset n w * pf asset (Suc n) w)  borel_measurable M"
      proof -
        have "prices Mkt asset n  borel_measurable M" using assms readable
          using asset  support_set pf borel_adapt_stoch_proc_borel_measurable by blast
        moreover have "pf asset (Suc n)  borel_measurable M" using assms unfolding trading_strategy_def
          using asset  support_set pf borel_predict_stoch_proc_borel_measurable by blast
        ultimately show ?thesis by simp
      qed
      thus "(λw. prices Mkt asset n w * pf asset (Suc n) w)  borel_measurable N" using assms by (simp add:filt_equiv_measurable)
    qed
  qed
  show "n. assetsupport_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
  proof (intro allI ballI)
    fix n
    fix asset
    assume "assetsupport_set pf"
    show "integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
    proof (rule prob_space.finite_borel_measurable_integrable)
      show "prob_space N" using assms unfolding risk_neutral_prob_def by auto
      have "finite ((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M)"
      proof -
        have "y prices Mkt asset (Suc n) `(space M). finite ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)"
          by (metis asset  support_set pf assms(7) finite_imageI image_image)
        hence "finite ( y prices Mkt asset (Suc n) `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y))"
          using asset  support_set pf assms(6) by blast
        moreover have "( y prices Mkt asset (Suc n) `(space M). ((λ z. (λw. z * pf asset (Suc n) w) ` space M) y)) =
          ( y prices Mkt asset (Suc n) `(space M). (λw. y * pf asset (Suc n) w) ` space M)"  by simp
        moreover have "((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M) 
          ( y prices Mkt asset (Suc n) `(space M). (λw. y * pf asset (Suc n) w) ` space M)"
        proof
          fix x
          assume "x  (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M"
          show "x  (yprices Mkt asset (Suc n) ` space M. (λw. y * pf asset (Suc n) w) ` space M)"
            using x  (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space M by auto
        qed
        ultimately show ?thesis by (simp add:finite_subset)
      qed
      thus "finite ((λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w) ` space N)" using assms by (simp add:filt_equiv_space)
      have "(λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)  borel_measurable M"
      proof -
        have "prices Mkt asset (Suc n)  borel_measurable M" using assms readable
          using asset  support_set pf borel_adapt_stoch_proc_borel_measurable by blast
        moreover have "pf asset (Suc n)  borel_measurable M" using assms unfolding trading_strategy_def
          using asset  support_set pf borel_predict_stoch_proc_borel_measurable by blast
        ultimately show ?thesis by simp
      qed
      thus "(λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)  borel_measurable N" using assms by (simp add:filt_equiv_measurable)
    qed
  qed
  show "stock_portfolio Mkt pf" using assms stock_portfolio_def
    by (simp add: stock_portfolio_def trading_strategy_def)
qed


lemma (in rfr_disc_equity_market) replicating_expectation:
  assumes "risk_neutral_prob N"
  and "filt_equiv F M N"
  and "replicating_portfolio pf pyf matur"
  and "n.  asset  support_set pf. integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
  and "n.  asset  support_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
  and "viable_market Mkt"
  and "sets (F 0) = {{}, space M}"
  and "pyf   borel_measurable (F matur)"
shows "fair_price Mkt (prob_space.expectation N (discounted_value r (λm. pyf) matur)) pyf matur"
proof -
  have fn: "filtrated_prob_space N F" using assms
    by (simp add: pyf  borel_measurable (F matur) filtrated_prob_space_axioms.intro
        filtrated_prob_space_def risk_neutral_prob_def filt_equiv_filtration)
  have "discounted_value r (cls_val_process Mkt pf) matur  borel_measurable N"
    using assms(3) disc_equity_market.replicating_portfolio_def disc_equity_market_axioms discounted_adapted
    filtrated_prob_space.borel_adapt_stoch_proc_borel_measurable fn cls_val_process_adapted
    by (metis (no_types, hide_lams) support_adapt_def readable  stock_portfolio_def subsetCE)
  have "discounted_value r (λm. pyf) matur  borel_measurable N"
  proof -
    have "(λm. pyf) matur  borel_measurable (F matur)" using assms by simp
    hence "(λm. pyf) matur  borel_measurable M"  using filtration filtrationE1 measurable_from_subalg by blast
    hence "(λm. pyf) matur  borel_measurable N" using assms by (simp add:filt_equiv_measurable)
    thus ?thesis by (simp add:discounted_measurable)
  qed
  have mpyf: "AE w in M. cls_val_process Mkt pf matur w = pyf w" using assms unfolding replicating_portfolio_def by simp
  have "AE w in N. cls_val_process Mkt pf matur w = pyf w"
  proof (rule filt_equiv_borel_AE_eq)
    show "filt_equiv F M N" using assms by simp
    show "pyf  borel_measurable (F matur)" using assms by simp
    show "AE w in M. cls_val_process Mkt pf matur w = pyf w" using mpyf by simp
    show "cls_val_process Mkt pf matur  borel_measurable (F matur)"
      using assms(3) price_structure_def replicating_price_process
      by (meson support_adapt_def disc_equity_market.replicating_portfolio_def disc_equity_market_axioms readable  stock_portfolio_def subsetCE)
  qed
  hence disc:"AE w in N. discounted_value r (cls_val_process Mkt pf) matur w = discounted_value r (λm. pyf) matur w"
    by (simp add:discounted_AE_cong)
  have "AEeq N (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur))
    (real_cond_exp N (F 0) (discounted_value r (λm. pyf) matur))"
  proof (rule sigma_finite_subalgebra.real_cond_exp_cong)
    show "sigma_finite_subalgebra N (F 0)"
      using filtrated_prob_space.axioms(1) filtrated_prob_space.filtration fn filtrationE1
        prob_space.subalgebra_sigma_finite by blast
    show "AEeq N (discounted_value r (cls_val_process Mkt pf) matur) (discounted_value r (λm. pyf) matur)" using disc by simp
    show "discounted_value r (cls_val_process Mkt pf) matur  borel_measurable N"
      using ‹discounted_value r (cls_val_process Mkt pf) matur  borel_measurable N .
    show "discounted_value r (λm. pyf) matur  borel_measurable N"
      using ‹discounted_value r (λm. pyf) matur  borel_measurable N .
  qed
  have "martingale N F (discounted_value r (cls_val_process Mkt pf))" using assms unfolding replicating_portfolio_def
    using self_fin_trad_strat_mart[of N pf] by (simp add: stock_portfolio_def)
  hence "AEeq N (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur))
    (discounted_value r (cls_val_process Mkt pf) 0)" using martingaleAE[of N F "discounted_value r (cls_val_process Mkt pf)" 0 matur]
    fn by simp
  also have "AE w in N. (discounted_value r (cls_val_process Mkt pf) 0 w) = initial_value pf"
  proof
    fix w
    assume "w space N"
    have "discounted_value r (cls_val_process Mkt pf) 0 w = cls_val_process Mkt pf 0 w" by (simp add:discounted_init)
    also have "... = val_process Mkt pf 0 w" unfolding cls_val_process_def using assms
      unfolding replicating_portfolio_def stock_portfolio_def by simp
    also have "... = initial_value pf" using assms unfolding replicating_portfolio_def using w space N
      by (metis (no_types, lifting) support_adapt_def filt_equiv_space initial_valueI readable stock_portfolio_def subsetCE)
    finally show "discounted_value r (cls_val_process Mkt pf) 0 w = initial_value pf" .
  qed
  finally have "AE w in N. (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur)) w =
    initial_value pf" .
  moreover have "w space N. (real_cond_exp N (F 0) (discounted_value r (cls_val_process Mkt pf) matur)) w =
    prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur)"
  proof (rule prob_space.trivial_subalg_cond_expect_eq)
    show "prob_space N" using assms unfolding risk_neutral_prob_def by simp
    show "subalgebra N (F 0)"
      using ‹prob_space N filtrated_prob_space.filtration fn filtrationE1 by blast
    show "sets (F 0) = {{}, space N}" using assms by (simp add:filt_equiv_space)
    show "integrable N (discounted_value r (cls_val_process Mkt pf) matur)"
    proof (rule discounted_integrable)
      show "space N = space M" using assms by (simp add:filt_equiv_space)
      show "integrable N (cls_val_process Mkt pf matur)" using assms unfolding replicating_portfolio_def
        by (simp add: integrable_self_fin_uvp)
      show "-1 < r" using acceptable_rate by simp
    qed
  qed
  ultimately have "AE w in N. prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur) =
     initial_value pf" by simp
  hence "prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur) =
    initial_value pf" using assms unfolding risk_neutral_prob_def using  prob_space.emeasure_space_1[of N]
    AE_eq_cst[of _ _ N] by simp
  moreover have "prob_space.expectation N (discounted_value r (cls_val_process Mkt pf) matur) =
    prob_space.expectation N (discounted_value r (λm. pyf) matur)"
  proof (rule integral_cong_AE)
    show "AEeq N (discounted_value r (cls_val_process Mkt pf) matur) (discounted_value r (λm. pyf) matur)"
      using disc by simp
    show "discounted_value r (λm. pyf) matur  borel_measurable N"
      using ‹discounted_value r (λm. pyf) matur  borel_measurable N .
    show "discounted_value r (cls_val_process Mkt pf) matur  borel_measurable N"
      using ‹discounted_value r (cls_val_process Mkt pf) matur  borel_measurable N .
  qed
  ultimately have "prob_space.expectation N (discounted_value r (λm. pyf) matur) = initial_value pf" by simp
  thus ?thesis using assms
    by (metis (full_types) support_adapt_def disc_equity_market.replicating_portfolio_def disc_equity_market_axioms
        readable replicating_fair_price stock_portfolio_def subsetCE)
qed


lemma (in rfr_disc_equity_market) replicating_expectation_finite:
  assumes "risk_neutral_prob N"
  and "filt_equiv F M N"
  and "replicating_portfolio pf pyf matur"
  and "n.  asset  support_set pf. finite (prices Mkt asset n `(space M))"
  and "n.  asset  support_set pf. finite (pf asset n `(space M))"
  and "viable_market Mkt"
  and "sets (F 0) = {{}, space M}"
  and "pyf   borel_measurable (F matur)"
shows "fair_price Mkt (prob_space.expectation N (discounted_value r (λm. pyf) matur)) pyf matur"
proof -
  have  "n.  asset  support_set pf. integrable N (λw. prices Mkt asset n w * pf asset (Suc n) w)"
  proof (rule finite_integrable_vp, (auto simp add:assms))
    show "prob_space N" using assms unfolding risk_neutral_prob_def by simp
    show "trading_strategy pf" using assms unfolding replicating_portfolio_def by simp
    show "n asset. asset  support_set pf  random_variable borel (prices Mkt asset n)"
    proof-
      fix n
      fix asset
      assume "asset  support_set pf"
      show "random_variable borel (prices Mkt asset n)"
        using assms unfolding replicating_portfolio_def stock_portfolio_def  adapt_stoch_proc_def using readable
        by (meson asset  support_set pf adapt_stoch_proc_borel_measurable subsetCE)
    qed
  qed
  moreover have "n.  asset  support_set pf. integrable N (λw. prices Mkt asset (Suc n) w * pf asset (Suc n) w)"
  proof (rule finite_integrable_uvp, (auto simp add:assms))
    show "prob_space N" using assms unfolding risk_neutral_prob_def by simp
    show "trading_strategy pf" using assms unfolding replicating_portfolio_def by simp
    show "n asset. asset  support_set pf  random_variable borel (prices Mkt asset n)"
    proof-
      fix n
      fix asset
      assume "asset  support_set pf"
      show "random_variable borel (prices Mkt asset n)"
        using assms unfolding replicating_portfolio_def stock_portfolio_def  adapt_stoch_proc_def using readable
        by (meson asset  support_set pf adapt_stoch_proc_borel_measurable subsetCE)
    qed
  qed
  ultimately show ?thesis using assms replicating_expectation by simp
qed



end

Theory CRR_Model

(*  Title:      CRR_Model.thy
    Author:     Mnacho Echenim, Univ. Grenoble Alpes
*)

section ‹The Cox Ross Rubinstein model›

text ‹This section defines the Cox-Ross-Rubinstein model of a financial market, and charcterizes a risk-neutral
probability space for this market. This, together with the proof that every derivative is attainable, permits to
obtain a formula to explicitely compute the fair price of any derivative.›

theory CRR_Model imports Fair_Price

begin

locale CRR_hyps = prob_grw + rsk_free_asset +
  fixes stk
assumes stocks: "stocks Mkt = {stk, risk_free_asset}"
  and stk_price: "prices Mkt stk = geom_proc"
  and S0_positive: "0 < init"
  and down_positive: "0 < d" and down_lt_up: "d < u"
  and psgt: "0 < p"
  and pslt: "p < 1"


locale CRR_market = CRR_hyps +
  fixes G
assumes stock_filtration:"G = stoch_proc_filt M geom_proc borel"

subsection ‹Preliminary results on the market›

lemma (in CRR_market) case_asset:
  assumes "asset  stocks Mkt"
  shows "asset = stk  asset = risk_free_asset"
proof (rule ccontr)
  assume "¬ (asset = stk  asset = risk_free_asset)"
  hence "asset  stk  asset  risk_free_asset" by simp
  moreover have "asset  {stk, risk_free_asset}" using assms stocks by simp
  ultimately show False by auto
qed

lemma (in CRR_market)
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows bernoulli_gen_filtration: "filtration N G"
and bernoulli_sigma_finite: "n. sigma_finite_subalgebra N (G n)"
proof -
  show "filtration N G"
  proof -
    have "disc_filtr M (stoch_proc_filt M geom_proc borel)"
    proof (rule stoch_proc_filt_disc_filtr)
      fix i
      show "random_variable borel (geom_proc i)"
        by (simp add: geom_rand_walk_borel_measurable)
    qed
    hence "filtration M G" using stock_filtration  by (simp add: filtration_def disc_filtr_def)
    have "filt_equiv nat_filtration M N" using pslt psgt by (simp add: assms bernoulli_stream_equiv)
    hence "sets N = sets M" unfolding filt_equiv_def by simp
    thus ?thesis unfolding filtration_def
      by (metis filtration_def ‹Filtration.filtration M G sets_eq_imp_space_eq subalgebra_def)
  qed
  show "n. sigma_finite_subalgebra N (G n)" using assms unfolding subalgebra_def
    using  filtration_def  subalgebra_sigma_finite
    by (metis ‹Filtration.filtration N G bernoulli_stream_def prob_space.prob_space_stream_space
        prob_space.subalgebra_sigma_finite prob_space_measure_pmf)
qed


sublocale CRR_market  rfr_disc_equity_market  _ G
proof (unfold_locales)
  show  "disc_filtr M G  sets (G ) = {{}, space M}"
  proof
    show "sets (G ) = {{}, space M}" using infinite_cts_filtration.stoch_proc_filt_triv_init stock_filtration geometric_process
        geom_rand_walk_borel_adapted
      by (meson infinite_coin_toss_space_axioms infinite_cts_filtration_axioms.intro infinite_cts_filtration_def
          init_triv_filt_def)
    show "disc_filtr M G"
      by (metis Filtration.filtration_def bernoulli bernoulli_gen_filtration disc_filtr_def psgt pslt)
  qed
  show "assetstocks Mkt. borel_adapt_stoch_proc G (prices Mkt asset)"
  proof -
    have "borel_adapt_stoch_proc G (prices Mkt stk)" using stk_price stock_filtration stoch_proc_filt_adapt
      by (simp add: stoch_proc_filt_adapt geom_rand_walk_borel_measurable)
    moreover have "borel_adapt_stoch_proc G (prices Mkt risk_free_asset)"
      using ‹disc_filtr M G  sets (G ) = {{}, space M} disc_filtr_prob_space.disc_rfr_proc_borel_adapted
        disc_filtr_prob_space.intro disc_filtr_prob_space_axioms.intro prob_space_axioms rf_price by fastforce
    moreover have "disc_filtr_prob_space M G" proof (unfold_locales)
      show "disc_filtr M G" by (simp add: ‹disc_filtr M G  sets (G ) = {{}, space M})
    qed
    ultimately show ?thesis using stocks by force
  qed
qed




lemma (in CRR_market) two_stocks:
shows "stk  risk_free_asset"
proof (rule ccontr)
  assume "¬stk  risk_free_asset"
  hence "disc_rfr_proc r = prices Mkt stk" using rf_price by simp
  also have "... = geom_proc" using stk_price by simp
  finally have eqf: "disc_rfr_proc r = geom_proc" .
  hence "w. disc_rfr_proc r 0 w = geom_proc 0 w" by simp
  hence "1 = init" using geometric_process by simp
  have eqfs: "w. disc_rfr_proc r (Suc 0) w = geom_proc (Suc 0) w" using eqf by simp
  hence "disc_rfr_proc r (Suc 0) (sconst True) = geom_proc (Suc 0) (sconst True)" by simp
  hence "1+r = u" using geometric_process 1 = init by simp
  have "disc_rfr_proc r (Suc 0) (sconst False) = geom_proc (Suc 0) (sconst False)" using eqfs by simp
  hence "1+r = d" using geometric_process 1 = init by simp
  show False using 1+r = u 1+r = d down_lt_up by simp
qed


lemma (in CRR_market) stock_pf_vp_expand:
  assumes "stock_portfolio Mkt pf"
  shows "val_process Mkt pf n w = geom_proc n w * pf stk (Suc n) w +
    disc_rfr_proc r n w * pf risk_free_asset (Suc n) w"
proof -
  have "val_process Mkt pf n w =(sum (λx. ((prices Mkt) x n w) * (pf x (Suc n) w)) (stocks Mkt))"
  proof (rule subset_val_process')
    show "finite (stocks Mkt)" using stocks by auto
    show "support_set pf  stocks Mkt" using assms unfolding stock_portfolio_def by simp
  qed
  also have "... = (x {stk, risk_free_asset}. ((prices Mkt) x n w) * (pf x (Suc n) w))" using stocks  by simp
  also have "... =  prices Mkt stk n w * pf stk (Suc n) w +
    ( x {risk_free_asset}. ((prices Mkt) x n w) * (pf x (Suc n) w))" by (simp add:two_stocks)
  also have "... = prices Mkt stk n w * pf stk (Suc n) w +
    prices Mkt risk_free_asset n w * pf risk_free_asset (Suc n) w" by simp
  also have "... = geom_proc n w * pf stk (Suc n) w + disc_rfr_proc r n w * pf risk_free_asset (Suc n) w"
    using rf_price stk_price by simp
  finally show ?thesis .
qed

lemma (in CRR_market) stock_pf_uvp_expand:
  assumes "stock_portfolio Mkt pf"
  shows "cls_val_process Mkt pf (Suc n) w = geom_proc (Suc n) w * pf stk (Suc n) w +
    disc_rfr_proc r (Suc n) w * pf risk_free_asset (Suc n) w"
proof -
  have "cls_val_process Mkt pf (Suc n) w =(sum (λx. ((prices Mkt) x (Suc n) w) * (pf x (Suc n) w)) (stocks Mkt))"
  proof (rule subset_cls_val_process')
    show "finite (stocks Mkt)" using stocks by auto
    show "support_set pf  stocks Mkt" using assms unfolding stock_portfolio_def by simp
  qed
  also have "... = (x {stk, risk_free_asset}. ((prices Mkt) x (Suc n) w) * (pf x (Suc n) w))" using  stocks by simp
  also have "... =  prices Mkt stk (Suc n) w * pf stk (Suc n) w +
    ( x {risk_free_asset}. ((prices Mkt) x (Suc n) w) * (pf x (Suc n) w))" by (simp add:two_stocks)
  also have "... = prices Mkt stk (Suc n) w * pf stk (Suc n) w +
    prices Mkt risk_free_asset (Suc n) w * pf risk_free_asset (Suc n) w" by simp
  also have "... = geom_proc (Suc n) w * pf stk (Suc n) w + disc_rfr_proc r (Suc n) w * pf risk_free_asset (Suc n) w"
    using rf_price stk_price by simp
  finally show ?thesis .
qed



lemma (in CRR_market) pos_pf_neg_uvp:
  assumes "stock_portfolio Mkt pf"
  and "d < 1+r"
  and "0 < pf stk (Suc n) (spick w n False)"
  and "val_process Mkt pf n (spick w n False)  0"
shows "cls_val_process Mkt pf (Suc n) (spick w n False) < 0"
proof -
  define wnf where "wnf = spick w n False"
  have "cls_val_process Mkt pf (Suc n) (spick w n False) =
    geom_proc (Suc n) wnf * pf stk (Suc n) wnf +
    disc_rfr_proc r (Suc n) wnf * pf risk_free_asset (Suc n) wnf" unfolding wnf_def
    using assms by (simp add:stock_pf_uvp_expand)
  also have "... = d * geom_proc n wnf * pf stk (Suc n) wnf + disc_rfr_proc r (Suc n) wnf * pf risk_free_asset (Suc n) wnf"
    unfolding wnf_def using geometric_process spickI[of n w False] by simp
  also have "... = d * geom_proc n wnf * pf stk (Suc n) wnf + (1+r) * disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf"
    by simp
  also have "... < (1+r) * geom_proc n wnf * pf stk (Suc n) wnf + (1+r) * disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf"
    unfolding wnf_def using assms geom_rand_walk_strictly_positive S0_positive
      down_positive down_lt_up by simp
  also have "... = (1+r) * (geom_proc n wnf * pf stk (Suc n) wnf + disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf)"
    by (simp add: distrib_left)
  also have "... = (1+r) * val_process Mkt pf n wnf" using stock_pf_vp_expand assms by simp
  also have "...  0"
  proof -
    have "0 < 1+r" using assms down_positive by simp
    moreover have "val_process Mkt pf n wnf  0" using assms unfolding wnf_def by simp
    ultimately show "(1+r) * (val_process Mkt pf n wnf)   0" unfolding wnf_def
      using less_eq_real_def[of 0 "1+r"] mult_nonneg_nonpos[of "1+r" "val_process Mkt pf n (spick w n False)"] by simp
  qed
  finally show ?thesis .
qed


lemma (in CRR_market) neg_pf_neg_uvp:
  assumes "stock_portfolio Mkt pf"
  and "1+r < u"
  and "pf stk (Suc n) (spick w n True) < 0"
  and "val_process Mkt pf n (spick w n True)  0"
shows "cls_val_process Mkt pf (Suc n) (spick w n True) < 0"
proof -
  define wnf where "wnf = spick w n True"
  have "cls_val_process Mkt pf (Suc n) (spick w n True) =
    geom_proc (Suc n) wnf * pf stk (Suc n) wnf +
    disc_rfr_proc r (Suc n) wnf * pf risk_free_asset (Suc n) wnf" unfolding wnf_def
    using assms by (simp add:stock_pf_uvp_expand)
  also have "... = u * geom_proc n wnf * pf stk (Suc n) wnf + disc_rfr_proc r (Suc n) wnf * pf risk_free_asset (Suc n) wnf"
    unfolding wnf_def using geometric_process spickI[of n w True] by simp
  also have "... = u * geom_proc n wnf * pf stk (Suc n) wnf + (1+r) * disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf"
    by simp
  also have "... < (1+r) * geom_proc n wnf * pf stk (Suc n) wnf + (1+r) * disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf"
    unfolding wnf_def using assms geom_rand_walk_strictly_positive S0_positive
      down_positive down_lt_up by simp
  also have "... = (1+r) * (geom_proc n wnf * pf stk (Suc n) wnf + disc_rfr_proc r n wnf * pf risk_free_asset (Suc n) wnf)"
    by (simp add: distrib_left)
  also have "... = (1+r) * val_process Mkt pf n wnf" using stock_pf_vp_expand assms by simp
  also have "...  0"
  proof -
    have "0 < 1+r" using acceptable_rate by simp
    moreover have "val_process Mkt pf n wnf  0" using assms unfolding wnf_def by simp
    ultimately show "(1+r) * (val_process Mkt pf n wnf)   0" unfolding wnf_def
      using less_eq_real_def[of 0 "1+r"] mult_nonneg_nonpos[of "1+r" "val_process Mkt pf n (spick w n True)"] by simp
  qed
  finally show ?thesis .
qed




lemma (in CRR_market) zero_pf_neg_uvp:
  assumes "stock_portfolio Mkt pf"
  and "pf stk (Suc n) w = 0"
  and "pf risk_free_asset (Suc n) w  0"
  and "val_process Mkt pf n w  0"
shows "cls_val_process Mkt pf (Suc n) w < 0"
proof -
  have "cls_val_process Mkt pf (Suc n) w =
    S (Suc n) w * pf stk (Suc n) w +
    disc_rfr_proc r (Suc n) w * pf risk_free_asset (Suc n) w"
    using assms by (simp add:stock_pf_uvp_expand)
  also have "... = disc_rfr_proc r (Suc n) w * pf risk_free_asset (Suc n) w" using assms by simp
  also have "... = (1+r) * disc_rfr_proc r n w * pf risk_free_asset (Suc n) w" by simp
  also have "... < 0"
  proof -
    have "0 < 1+r" using acceptable_rate by simp
    moreover have "0 < disc_rfr_proc r n w" using acceptable_rate by (simp add: disc_rfr_proc_positive)
    ultimately have "0 < (1+r) * disc_rfr_proc r n w" by simp
    have 1: "0< pf risk_free_asset (Suc n) w  0 <(1+r) * disc_rfr_proc r n w * pf risk_free_asset (Suc n) w"
    proof (intro impI)
      assume "0 < pf risk_free_asset (Suc n) w"
      thus "0 < (1 + r) * disc_rfr_proc r n w * pf risk_free_asset (Suc n) w" using 0 < (1+r) * disc_rfr_proc r n w
        by simp
    qed
    have 2: "pf risk_free_asset (Suc n) w < 0  (1+r) * disc_rfr_proc r n w * pf risk_free_asset (Suc n) w < 0"
    proof (intro impI)
      assume "pf risk_free_asset (Suc n) w < 0"
      thus "(1 + r) * disc_rfr_proc r n w * pf risk_free_asset (Suc n) w < 0" using 0 < (1+r) * disc_rfr_proc r n w
        by (simp add:mult_pos_neg)
    qed
    have "0  val_process Mkt pf n w" using assms by simp
    also have "val_process Mkt pf n w = geom_proc n w * pf stk (Suc n) w +
      disc_rfr_proc r n w * pf risk_free_asset (Suc n) w" using assms by (simp add:stock_pf_vp_expand)
    also have "... = disc_rfr_proc r n w * pf risk_free_asset (Suc n) w" using assms by simp
    finally have "0 disc_rfr_proc r n w * pf risk_free_asset (Suc n) w" .
    have "0< pf risk_free_asset (Suc n) w  pf risk_free_asset (Suc n) w < 0"  using assms
       by linarith
    thus ?thesis
      using "2" 0 < disc_rfr_proc r n w ‹disc_rfr_proc r n w * pf risk_free_asset (Suc n) w  0
        mult_pos_pos by fastforce
  qed
  finally show ?thesis .
qed



lemma (in CRR_market) neg_pf_exists:
  assumes "stock_portfolio Mkt pf"
  and "trading_strategy pf"
  and "1+r < u"
  and "d < 1+r"
  and "val_process Mkt pf n w  0"
  and "pf stk (Suc n) w  0  pf risk_free_asset (Suc n) w  0"
shows "y. cls_val_process Mkt pf (Suc n) y < 0"
proof -
  have "borel_predict_stoch_proc G (pf stk)"
  proof (rule inc_predict_support_trading_strat')
    show "trading_strategy pf" using assms by simp
    show "stk  support_set pf  {stk}" by simp
  qed
  hence "pf stk (Suc n)  borel_measurable (G n)" unfolding predict_stoch_proc_def by simp
  have "val_process Mkt pf n  borel_measurable (G n)"
  proof -
    have "borel_adapt_stoch_proc G (val_process Mkt pf)" using assms
      using support_adapt_def ats_val_process_adapted readable unfolding  stock_portfolio_def by blast
    thus ?thesis unfolding adapt_stoch_proc_def by simp
  qed
  define wn where "wn = pseudo_proj_True n w"
  show ?thesis
  proof (cases "pf stk (Suc n) w  0")
    case True
    show ?thesis
    proof (cases "pf stk (Suc n) w > 0")
      case True
      have "0 <pf stk (Suc n) (spick wn n False)"
      proof -
        have "0 < pf stk (Suc n) w" using 0 < pf stk (Suc n) w by simp
        also have "... = pf stk (Suc n) wn" unfolding wn_def
          using pf stk (Suc n)  borel_measurable (G n) stoch_proc_subalg_nat_filt[of geom_proc] geometric_process
          nat_filtration_info stock_filtration
          by (metis comp_apply geom_rand_walk_borel_adapted measurable_from_subalg)
        also have "... = pf stk (Suc n) (spick wn n False)" using pf stk (Suc n)  borel_measurable (G n) comp_def nat_filtration_info
              pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
          by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
        finally show ?thesis .
      qed
      moreover have "0  val_process Mkt pf n (spick wn n False)"
      proof -
        have "0  val_process Mkt pf n w" using assms by simp
        also have "val_process Mkt pf n w = val_process Mkt pf n wn" unfolding wn_def using ‹val_process Mkt pf n  borel_measurable (G n)
          nat_filtration_info stoch_proc_subalg_nat_filt[of geom_proc] geometric_process
          stock_filtration by (metis comp_apply geom_rand_walk_borel_adapted measurable_from_subalg)
        also have "... = val_process Mkt pf n (spick wn n False)" using ‹val_process Mkt pf n  borel_measurable (G n)
          comp_def nat_filtration_info
              pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
          by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
        finally show ?thesis .
      qed
      ultimately have "cls_val_process Mkt pf (Suc n) (spick wn n False) < 0" using assms
        by (simp add:pos_pf_neg_uvp)
      thus "y. cls_val_process Mkt pf (Suc n) y < 0" by auto
    next
      case False
      have "0 >pf stk (Suc n) (spick wn n True)"
      proof -
        have "0 > pf stk (Suc n) w" using ¬ 0 < pf stk (Suc n) w pf stk (Suc n) w  0 by simp
        also have "pf stk (Suc n) w = pf stk (Suc n) wn" unfolding wn_def using pf stk (Suc n)  borel_measurable (G n)
          nat_filtration_info stoch_proc_subalg_nat_filt[of geom_proc] geometric_process
          stock_filtration by (metis comp_apply geom_rand_walk_borel_adapted measurable_from_subalg)
        also have "... = pf stk (Suc n) (spick wn n True)" using pf stk (Suc n)  borel_measurable (G n)
          comp_def nat_filtration_info
              pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
          by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
        finally show ?thesis .
      qed
      moreover have "0  val_process Mkt pf n (spick wn n True)"
      proof -
        have "0  val_process Mkt pf n w" using assms by simp
        also have "val_process Mkt pf n w = val_process Mkt pf n wn" unfolding wn_def using ‹val_process Mkt pf n  borel_measurable (G n)
          comp_def nat_filtration_info
              pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
          by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
        also have "... = val_process Mkt pf n (spick wn n True)" using ‹val_process Mkt pf n  borel_measurable (G n)
          comp_def nat_filtration_info
              pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
          by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
        finally show ?thesis .
      qed
      ultimately have "cls_val_process Mkt pf (Suc n) (spick wn n True) < 0" using assms
        by (simp add:neg_pf_neg_uvp)
      thus "y. cls_val_process Mkt pf (Suc n) y < 0" by auto
    qed
  next
    case False
    hence "pf risk_free_asset (Suc n) w  0" using assms by simp
    hence "cls_val_process Mkt pf (Suc n) w < 0" using False assms by (auto simp add:zero_pf_neg_uvp)
    thus "y. cls_val_process Mkt pf (Suc n) y < 0" by auto
  qed
qed


lemma (in CRR_market) non_zero_components:
assumes "val_process Mkt pf n y  0"
and "stock_portfolio Mkt pf"
shows  "pf stk (Suc n) y  0  pf risk_free_asset (Suc n) y  0"
proof (rule ccontr)
  assume "¬(pf stk (Suc n) y  0  pf risk_free_asset (Suc n) y  0)"
  hence "pf stk (Suc n) y = 0" "pf risk_free_asset (Suc n) y = 0" by auto
  have "val_process Mkt pf n y = geom_proc n y * pf stk (Suc n) y +
    disc_rfr_proc r n y * pf risk_free_asset (Suc n) y" using ‹stock_portfolio Mkt pf
    stock_pf_vp_expand[of pf n]  by simp
  also have "... = 0" using pf stk (Suc n) y = 0 pf risk_free_asset (Suc n) y = 0 by simp
  finally have "val_process Mkt pf n y = 0" .
  moreover have "val_process Mkt pf n y  0" using assms by simp
  ultimately show False by simp
qed

lemma (in CRR_market) neg_pf_Suc:
  assumes "stock_portfolio Mkt pf"
  and "trading_strategy pf"
  and "self_financing Mkt pf"
  and "1+r < u"
  and "d < 1+r"
  and "cls_val_process Mkt pf n w < 0"
shows "n  m  y. cls_val_process Mkt pf m y < 0"
proof (induct m)
  case 0
  assume "n  0"
  hence "n=0" by simp
  thus "y. cls_val_process Mkt pf 0 y < 0" using assms by auto
next
  case (Suc m)
  assume "n  Suc m"
  thus "y. cls_val_process Mkt pf (Suc m) y < 0"
  proof (cases "n < Suc m")
    case False
    hence "n = Suc m" using n  Suc m by simp
    thus "y. cls_val_process Mkt pf (Suc m) y < 0" using assms by auto
  next
    case True
    hence "n  m" by simp
    hence "y. cls_val_process Mkt pf m y < 0" using Suc by simp
    from this obtain y where "cls_val_process Mkt pf m y < 0" by auto
    hence "val_process Mkt pf m y < 0" using assms by (simp add:self_financingE)
    hence "val_process Mkt pf m y  0" by simp
    have "val_process Mkt pf m y  0" using ‹val_process Mkt pf m y < 0 by simp
    hence "pf stk (Suc m) y  0  pf risk_free_asset (Suc m) y  0" using assms non_zero_components by simp
    thus "y. cls_val_process Mkt pf (Suc m) y < 0" using neg_pf_exists[of pf m y] assms
      ‹val_process Mkt pf m y  0 by simp
  qed
qed




lemma (in CRR_market) viable_if:
  assumes "1+r < u"
  and "d < 1+r"
shows "viable_market Mkt" unfolding viable_market_def
proof (rule ccontr)
  assume "¬(p. stock_portfolio Mkt p  ¬ arbitrage_process Mkt p)"
  hence "p. stock_portfolio Mkt p  arbitrage_process Mkt p" by simp
  from this obtain pf where "stock_portfolio Mkt pf" and "arbitrage_process Mkt pf" by auto
  have "( m. (self_financing Mkt pf)  (trading_strategy pf) 
    (w  space M. cls_val_process Mkt pf 0 w = 0) 
    (AE w in M. 0  cls_val_process Mkt pf m w) 
    0 < 𝒫(w in M. cls_val_process Mkt pf m w > 0))" using ‹arbitrage_process Mkt pf
    using arbitrage_processE by simp
  from this obtain m where "self_financing Mkt pf" and "(trading_strategy pf)"
    and "(w  space M. cls_val_process Mkt pf 0 w = 0)"
    and "(AE w in M. 0  cls_val_process Mkt pf m w)"
    and "0 < 𝒫(w in M. cls_val_process Mkt pf m w > 0)" by auto
  have "{w space M. cls_val_process Mkt pf m w > 0}  {}" using
    0 < 𝒫(w in M. cls_val_process Mkt pf m w > 0) by force
  hence "w space M. cls_val_process Mkt pf m w > 0" by auto
  from this obtain y where "y space M" and "cls_val_process Mkt pf m y > 0" by auto
  define A where "A = {n::nat. n  m  cls_val_process Mkt pf n y > 0}"
  have "finite A" unfolding A_def by auto
  have "m  A" using ‹cls_val_process Mkt pf m y > 0 unfolding A_def by simp
  hence "A  {}" by auto
  hence "Min A  A" using ‹finite A by simp
  have "Min A  m" using ‹finite A m A by simp
  have "0 < Min A"
  proof -
    have "cls_val_process Mkt pf 0 y = 0" using y space M w  space M. cls_val_process Mkt pf 0 w = 0
      by simp
    hence "0 A" unfolding A_def by simp
    moreover have "0  Min A" by simp
    ultimately show ?thesis using ‹Min A  A neq0_conv by fastforce
  qed
  hence "l. Suc l = Min A" using Suc_diff_1 by blast
  from this obtain l where "Suc l = Min A" by auto
  have "cls_val_process Mkt pf l y  0"
  proof -
    have "l < Min A" using ‹Suc l = Min A by simp
    hence "l A" using ‹finite A A  {} by auto
    moreover have "l  m" using ‹Suc l = Min A m A ‹finite A A  {} l < Min A by auto
    ultimately show ?thesis unfolding A_def by auto
  qed
  hence "val_process Mkt pf l y  0" using ‹self_financing Mkt pf by (simp add:self_financingE)
  moreover have "pf stk (Suc l) y  0  pf risk_free_asset (Suc l) y  0"
  proof (rule ccontr)
    assume "¬(pf stk (Suc l) y  0  pf risk_free_asset (Suc l) y  0)"
    hence "pf stk (Suc l) y = 0" "pf risk_free_asset (Suc l) y = 0" by auto
    have "cls_val_process Mkt pf (Min A) y = geom_proc (Suc l) y * pf stk (Suc l) y +
      disc_rfr_proc r (Suc l) y * pf risk_free_asset (Suc l) y" using ‹stock_portfolio Mkt pf
      ‹Suc l = Min A stock_pf_uvp_expand[of pf l]  by simp
    also have "... = 0" using pf stk (Suc l) y = 0 pf risk_free_asset (Suc l) y = 0 by simp
    finally have "cls_val_process Mkt pf (Min A) y = 0" .
    moreover have "cls_val_process Mkt pf (Min A) y > 0" using ‹Min A  A unfolding A_def by simp
    ultimately show False by simp
  qed
  ultimately have "z. cls_val_process Mkt pf (Suc l) z < 0" using assms ‹stock_portfolio Mkt pf
    ‹trading_strategy pf by (simp add:neg_pf_exists)
  from this obtain z where "cls_val_process Mkt pf (Suc l) z < 0" by auto
  hence "x'. cls_val_process Mkt pf m x' < 0" using neg_pf_Suc assms ‹trading_strategy pf
      ‹self_financing Mkt pf ‹Suc l = Min A ‹Min A  m ‹stock_portfolio Mkt pf by simp
  from this obtain x' where "cls_val_process Mkt pf m x' < 0" by auto
  have "x' space M" using bernoulli_stream_space bernoulli by auto
  hence "x' {w space M. ¬0  cls_val_process Mkt pf m w}" using ‹cls_val_process Mkt pf m x' < 0 by auto
  from AE w in M. 0  cls_val_process Mkt pf m w obtain N where
    "{w space M. ¬0  cls_val_process Mkt pf m w}  N" and "emeasure M N = 0" and "N sets M" using AE_E by auto
  have "{w space M. (stake m w = stake m x')}  N"
  proof
    fix x
    assume "x  {w  space M. stake m w = stake m x'}"
    hence "x space M" and "stake m x = stake m x'" by auto
    have "cls_val_process Mkt pf m  borel_measurable (G m)"
    proof -
      have "borel_adapt_stoch_proc G (cls_val_process Mkt pf)" using ‹trading_strategy pf ‹stock_portfolio Mkt pf
        by (meson support_adapt_def readable  stock_portfolio_def subsetCE cls_val_process_adapted)
      thus ?thesis unfolding adapt_stoch_proc_def by simp
    qed
    hence "cls_val_process Mkt pf m x' = cls_val_process Mkt pf m x"
      using  ‹stake m x = stake m x' borel_measurable_stake[of "cls_val_process Mkt pf m" m x x']
      pseudo_proj_True_stake_image spickI stoch_proc_subalg_nat_filt[of geom_proc] geometric_process stock_filtration
          by (metis geom_rand_walk_borel_adapted measurable_from_subalg)
    hence "cls_val_process Mkt pf m x < 0" using ‹cls_val_process Mkt pf m x' < 0 by simp
    thus "x N" using {w space M. ¬0  cls_val_process Mkt pf m w}  N x space M
      ‹cls_val_process Mkt pf (Suc l) z < 0 by auto
  qed
  moreover have "emeasure M {w space M. (stake m w = stake m x')}  0" using bernoulli_stream_pref_prob_neq_zero psgt pslt by simp
  ultimately show False using ‹emeasure M N = 0 N  events› emeasure_eq_0 by blast
qed


lemma (in CRR_market) viable_only_if_d:
  assumes "viable_market Mkt"
  shows "d < 1+r"
proof (rule ccontr)
  assume "¬ d < 1+r"
  hence "1+r  d" by simp
  define arb_pf where "arb_pf = (λ (x::'a) (n::nat) w. 0::real)(stk:= (λ n w. 1), risk_free_asset := (λ n w. - geom_proc 0 w))"
  have "support_set arb_pf = {stk, risk_free_asset}"
  proof
    show "support_set arb_pf  {stk, risk_free_asset}"
      by (simp add: arb_pf_def subset_iff support_set_def)
    have "stk support_set arb_pf" unfolding arb_pf_def support_set_def using two_stocks by simp
    moreover have "risk_free_asset support_set arb_pf" unfolding arb_pf_def support_set_def
      using two_stocks geometric_process S0_positive by simp
    ultimately show "{stk, risk_free_asset} support_set arb_pf" by simp
  qed
  hence "stock_portfolio Mkt arb_pf" using stocks
    by (simp add: portfolio_def stock_portfolio_def)
  have "arbitrage_process Mkt arb_pf"
  proof (rule arbitrage_processI, intro exI conjI)
    show "self_financing Mkt arb_pf" unfolding arb_pf_def using ‹support_set arb_pf = {stk, risk_free_asset}
      by (simp add: static_portfolio_self_financing)
    show "trading_strategy arb_pf" unfolding trading_strategy_def
    proof (intro conjI ballI)
      show "portfolio arb_pf" unfolding portfolio_def using ‹support_set arb_pf = {stk, risk_free_asset} by simp
      fix asset
      assume "asset support_set arb_pf"
      show "borel_predict_stoch_proc G (arb_pf asset)"
      proof (cases "asset = stk")
        case True
        hence "arb_pf asset = (λ n w. 1)" unfolding arb_pf_def by (simp add: two_stocks)
        show ?thesis unfolding predict_stoch_proc_def
        proof
          show "arb_pf asset 0  borel_measurable (G 0)" using arb_pf asset = (λ n w. 1) by simp
          show "n. arb_pf asset (Suc n)  borel_measurable (G n)"
          proof
            fix n
            show "arb_pf asset (Suc n)  borel_measurable (G n)" using arb_pf asset = (λ n w. 1) by simp
          qed
        qed
      next
        case False
        hence "arb_pf asset = (λ n w. - geom_proc 0 w)" using ‹support_set arb_pf = {stk, risk_free_asset}
          asset  support_set arb_pf unfolding arb_pf_def by simp
        show ?thesis unfolding predict_stoch_proc_def
        proof
          show "arb_pf asset 0  borel_measurable (G 0)" using arb_pf asset = (λ n w. - geom_proc 0 w)
            geometric_process by simp
          show "n. arb_pf asset (Suc n)  borel_measurable (G n)"
          proof
            fix n
            show "arb_pf asset (Suc n)  borel_measurable (G n)" using arb_pf asset = (λ n w. - geom_proc 0 w)
              geometric_process by simp
          qed
        qed
      qed
    qed
    show "wspace M. cls_val_process Mkt arb_pf 0 w = 0"
    proof
      fix w
      assume "w space M"
      have "cls_val_process Mkt arb_pf 0 w = geom_proc 0 w * arb_pf stk (Suc 0) w +
        disc_rfr_proc r 0 w * arb_pf risk_free_asset (Suc 0) w" using stock_pf_vp_expand
        ‹stock_portfolio Mkt arb_pf
        using ‹self_financing Mkt arb_pf self_financingE by fastforce
      also have "... = geom_proc 0 w * (1) + disc_rfr_proc r 0 w * arb_pf risk_free_asset (Suc 0) w"
        by (simp add: arb_pf_def two_stocks)
      also have "... = geom_proc 0 w + arb_pf risk_free_asset (Suc 0) w" by simp
      also have "... = geom_proc 0 w  - geom_proc 0 w" unfolding arb_pf_def by simp
      also have "... = 0" by simp
      finally show "cls_val_process Mkt arb_pf 0 w = 0" .
    qed
    have dev: "w space M. cls_val_process Mkt arb_pf (Suc 0) w = geom_proc (Suc 0) w - (1+r) * geom_proc 0 w"
    proof (intro ballI)
      fix w
      assume "w space M"
      have "cls_val_process Mkt arb_pf (Suc 0) w =  geom_proc (Suc 0) w * arb_pf stk (Suc 0) w +
        disc_rfr_proc r (Suc 0) w * arb_pf risk_free_asset (Suc 0) w" using stock_pf_uvp_expand
        ‹stock_portfolio Mkt arb_pf by simp
      also have "... = geom_proc (Suc 0) w + disc_rfr_proc r (Suc 0) w * arb_pf risk_free_asset (Suc 0) w"
        by (simp add: arb_pf_def two_stocks)
      also have "... = geom_proc (Suc 0) w + (1+r) * arb_pf risk_free_asset (Suc 0) w" by simp
      also have "... = geom_proc (Suc 0) w - (1+r) * geom_proc 0 w" by (simp add:arb_pf_def)
      finally show "cls_val_process Mkt arb_pf (Suc 0) w = geom_proc (Suc 0) w - (1+r) * geom_proc 0 w" .
    qed
    have iniT: "w space M. snth w 0  cls_val_process Mkt arb_pf (Suc 0) w > 0"
    proof (intro ballI impI)
      fix w
      assume "w space M" and "snth w 0"
      have "cls_val_process Mkt arb_pf (Suc 0) w =  geom_proc (Suc 0) w - (1+r) * geom_proc 0 w"
        using dev w space M by simp
      also have "... = u * geom_proc 0 w - (1+r) * geom_proc 0 w" using ‹snth w 0 geometric_process by simp
      also have "... = (u - (1+r)) * geom_proc 0 w" by (simp add: left_diff_distrib)
      also have "... > 0" using S0_positive 1 + r  d down_lt_up geometric_process by auto
      finally show "cls_val_process Mkt arb_pf (Suc 0) w > 0" .
    qed
    have iniF: "w space M. ¬snth w 0  cls_val_process Mkt arb_pf (Suc 0) w  0"
    proof (intro ballI impI)
      fix w
      assume "w space M" and "¬snth w 0"
      have "cls_val_process Mkt arb_pf (Suc 0) w =  geom_proc (Suc 0) w - (1+r) * geom_proc 0 w"
        using dev w space M by simp
      also have "... = d * geom_proc 0 w - (1+r) * geom_proc 0 w" using ¬snth w 0 geometric_process by simp
      also have "... = (d - (1+r)) * geom_proc 0 w" by (simp add: left_diff_distrib)
      also have "...  0" using S0_positive 1 + r  d down_lt_up geometric_process by auto
      finally show "cls_val_process Mkt arb_pf (Suc 0) w  0" .
    qed
    have "w space M. cls_val_process Mkt arb_pf (Suc 0) w  0"
    proof
      fix w
      assume "w space M"
      show "cls_val_process Mkt arb_pf (Suc 0) w  0"
      proof (cases "snth w 0")
        case True
        thus ?thesis using w space M iniT by auto
      next
        case False
        thus ?thesis using w space M iniF by simp
      qed
    qed
    thus "AE w in M. 0  cls_val_process Mkt arb_pf (Suc 0) w" by simp
    show "0 < prob {w  space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w}"
    proof -
      have "cls_val_process Mkt arb_pf (Suc 0)  borel_measurable M" using borel_adapt_stoch_proc_borel_measurable
        cls_val_process_adapted ‹trading_strategy arb_pf ‹stock_portfolio Mkt arb_pf
        using support_adapt_def readable unfolding  stock_portfolio_def by blast
      hence set_event:"{w  space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w}  sets M"
        using borel_measurable_iff_greater by blast
      have "n. emeasure M {w  space M. w !! n} = ennreal p"
        using bernoulli p_gt_0 p_lt_1 bernoulli_stream_component_probability[of M p]
        by auto
      hence "emeasure M {w  space M. w !! 0} = ennreal p" by blast
      moreover have "{w  space M. w !! 0}  {w  space M. 0 < cls_val_process Mkt arb_pf 1 w}"
      proof
        fix w
        assume "w {w  space M. w !! 0}"
        hence "w  space M" and "w !! 0" by auto note wprops = this
        hence "0 < cls_val_process Mkt arb_pf 1 w" using iniT by simp
        thus "w {w  space M. 0 < cls_val_process Mkt arb_pf 1 w}" using wprops by simp
      qed
      ultimately have "p  emeasure M {w  space M. 0 < cls_val_process Mkt arb_pf 1 w}"
        using emeasure_mono set_event by fastforce
      hence "p  prob {w  space M. 0 < cls_val_process Mkt arb_pf 1 w}" by (simp add: emeasure_eq_measure)
      thus "0 < prob {w  space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w}" using psgt by simp
    qed
  qed
  thus False using assms unfolding viable_market_def using ‹stock_portfolio Mkt arb_pf by simp
qed


lemma (in CRR_market) viable_only_if_u:
  assumes "viable_market Mkt"
  shows "1+r < u"
proof (rule ccontr)
  assume "¬ 1+r < u"
  hence "u  1+r" by simp
  define arb_pf where "arb_pf = (λ (x::'a) (n::nat) w. 0::real)(stk:= (λ n w. -1), risk_free_asset := (λ n w. geom_proc 0 w))"
  have "support_set arb_pf = {stk, risk_free_asset}"
  proof
    show "support_set arb_pf  {stk, risk_free_asset}"
      by (simp add: arb_pf_def subset_iff support_set_def)
    have "stk support_set arb_pf" unfolding arb_pf_def support_set_def using two_stocks by simp
    moreover have "risk_free_asset support_set arb_pf" unfolding arb_pf_def support_set_def
      using two_stocks geometric_process S0_positive by simp
    ultimately show "{stk, risk_free_asset} support_set arb_pf" by simp
  qed
  hence "stock_portfolio Mkt arb_pf" using stocks
    by (simp add: portfolio_def stock_portfolio_def)
  have "arbitrage_process Mkt arb_pf"
  proof (rule arbitrage_processI, intro exI conjI)
    show "self_financing Mkt arb_pf" unfolding arb_pf_def using ‹support_set arb_pf = {stk, risk_free_asset}
      by (simp add: static_portfolio_self_financing)
    show "trading_strategy arb_pf" unfolding trading_strategy_def
    proof (intro conjI ballI)
      show "portfolio arb_pf" unfolding portfolio_def using ‹support_set arb_pf = {stk, risk_free_asset} by simp
      fix asset
      assume "asset support_set arb_pf"
      show "borel_predict_stoch_proc G (arb_pf asset)"
      proof (cases "asset = stk")
        case True
        hence "arb_pf asset = (λ n w. -1)" unfolding arb_pf_def by (simp add: two_stocks)
        show ?thesis unfolding predict_stoch_proc_def
        proof
          show "arb_pf asset 0  borel_measurable (G 0)" using arb_pf asset = (λ n w. -1) by simp
          show "n. arb_pf asset (Suc n)  borel_measurable (G n)"
          proof
            fix n
            show "arb_pf asset (Suc n)  borel_measurable (G n)" using arb_pf asset = (λ n w. -1) by simp
          qed
        qed
      next
        case False
        hence "arb_pf asset = (λ n w. geom_proc 0 w)" using ‹support_set arb_pf = {stk, risk_free_asset}
          asset  support_set arb_pf unfolding arb_pf_def by simp
        show ?thesis unfolding predict_stoch_proc_def
        proof
          show "arb_pf asset 0  borel_measurable (G 0)" using arb_pf asset = (λ n w. geom_proc 0 w)
            geometric_process by simp
          show "n. arb_pf asset (Suc n)  borel_measurable (G n)"
          proof
            fix n
            show "arb_pf asset (Suc n)  borel_measurable (G n)" using arb_pf asset = (λ n w. geom_proc 0 w)
              geometric_process by simp
          qed
        qed
      qed
    qed
    show "wspace M. cls_val_process Mkt arb_pf 0 w = 0"
    proof
      fix w
      assume "w space M"
      have "cls_val_process Mkt arb_pf 0 w = geom_proc 0 w * arb_pf stk (Suc 0) w +
        disc_rfr_proc r 0 w * arb_pf risk_free_asset (Suc 0) w" using stock_pf_vp_expand
        ‹stock_portfolio Mkt arb_pf
        using ‹self_financing Mkt arb_pf self_financingE by fastforce
      also have "... = geom_proc 0 w * (-1) + disc_rfr_proc r 0 w * arb_pf risk_free_asset (Suc 0) w"
        by (simp add: arb_pf_def two_stocks)
      also have "... = -geom_proc 0 w + arb_pf risk_free_asset (Suc 0) w" by simp
      also have "... = geom_proc 0 w  - geom_proc 0 w" unfolding arb_pf_def by simp
      also have "... = 0" by simp
      finally show "cls_val_process Mkt arb_pf 0 w = 0" .
    qed
    have dev: "w space M. cls_val_process Mkt arb_pf (Suc 0) w = -geom_proc (Suc 0) w + (1+r) * geom_proc 0 w"
    proof (intro ballI)
      fix w
      assume "w space M"
      have "cls_val_process Mkt arb_pf (Suc 0) w =  geom_proc (Suc 0) w * arb_pf stk (Suc 0) w +
        disc_rfr_proc r (Suc 0) w * arb_pf risk_free_asset (Suc 0) w" using stock_pf_uvp_expand
        ‹stock_portfolio Mkt arb_pf by simp
      also have "... = -geom_proc (Suc 0) w + disc_rfr_proc r (Suc 0) w * arb_pf risk_free_asset (Suc 0) w"
        by (simp add: arb_pf_def two_stocks)
      also have "... = -geom_proc (Suc 0) w + (1+r) * arb_pf risk_free_asset (Suc 0) w" by simp
      also have "... = -geom_proc (Suc 0) w + (1+r) * geom_proc 0 w" by (simp add:arb_pf_def)
      finally show "cls_val_process Mkt arb_pf (Suc 0) w = -geom_proc (Suc 0) w + (1+r) * geom_proc 0 w" .
    qed
    have iniT: "w space M. snth w 0  cls_val_process Mkt arb_pf (Suc 0) w  0"
    proof (intro ballI impI)
      fix w
      assume "w space M" and "snth w 0"
      have "cls_val_process Mkt arb_pf (Suc 0) w =  -geom_proc (Suc 0) w + (1+r) * geom_proc 0 w"
        using dev w space M by simp
      also have "... = - u * geom_proc 0 w + (1+r) * geom_proc 0 w" using ‹snth w 0 geometric_process by simp
      also have "... = (-u + (1+r)) * geom_proc 0 w" by (simp add: left_diff_distrib)
      also have "...  0" using S0_positive u 1 + r down_lt_up geometric_process by auto
      finally show "cls_val_process Mkt arb_pf (Suc 0) w  0" .
    qed
    have iniF: "w space M. ¬snth w 0  cls_val_process Mkt arb_pf (Suc 0) w > 0"
    proof (intro ballI impI)
      fix w
      assume "w space M" and "¬snth w 0"
      have "cls_val_process Mkt arb_pf (Suc 0) w =  -geom_proc (Suc 0) w + (1+r) * geom_proc 0 w"
        using dev w space M by simp
      also have "... = -d * geom_proc 0 w + (1+r) * geom_proc 0 w" using ¬snth w 0 geometric_process by simp
      also have "... = (-d + (1+r)) * geom_proc 0 w" by (simp add: left_diff_distrib)
      also have "... > 0" using S0_positive u <= 1 + r down_lt_up geometric_process by auto
      finally show "cls_val_process Mkt arb_pf (Suc 0) w > 0" .
    qed
    have "w space M. cls_val_process Mkt arb_pf (Suc 0) w  0"
    proof
      fix w
      assume "w space M"
      show "cls_val_process Mkt arb_pf (Suc 0) w  0"
      proof (cases "snth w 0")
        case True
        thus ?thesis using w space M iniT by simp
      next
        case False
        thus ?thesis using w space M iniF by auto
      qed
    qed
    thus "AE w in M. 0  cls_val_process Mkt arb_pf (Suc 0) w" by simp
    show "0 < prob {w  space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w}"
    proof -
      have "cls_val_process Mkt arb_pf (Suc 0)  borel_measurable M" using borel_adapt_stoch_proc_borel_measurable
        cls_val_process_adapted ‹trading_strategy arb_pf ‹stock_portfolio Mkt arb_pf
         using support_adapt_def readable unfolding stock_portfolio_def by blast
      hence set_event:"{w  space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w}  sets M"
        using borel_measurable_iff_greater by blast
      have "n. emeasure M {w  space M. ¬w !! n} = ennreal (1-p)"
        using bernoulli p_gt_0 p_lt_1 bernoulli_stream_component_probability_compl[of M p]
        by auto
      hence "emeasure M {w  space M. ¬w !! 0} = ennreal (1-p)" by blast
      moreover have "{w  space M. ¬w !! 0}  {w  space M. 0 < cls_val_process Mkt arb_pf 1 w}"
      proof
        fix w
        assume "w {w  space M. ¬w !! 0}"
        hence "w  space M" and "¬w !! 0" by auto note wprops = this
        hence "0 < cls_val_process Mkt arb_pf 1 w" using iniF by simp
        thus "w {w  space M. 0 < cls_val_process Mkt arb_pf 1 w}" using wprops by simp
      qed
      ultimately have "1-p  emeasure M {w  space M. 0 < cls_val_process Mkt arb_pf 1 w}"
        using emeasure_mono set_event by fastforce
      hence "1-p  prob {w  space M. 0 < cls_val_process Mkt arb_pf 1 w}" by (simp add: emeasure_eq_measure)
      thus "0 < prob {w  space M. 0 < cls_val_process Mkt arb_pf (Suc 0) w}" using pslt by simp
    qed
  qed
  thus False using assms unfolding viable_market_def using ‹stock_portfolio Mkt arb_pf by simp
qed

lemma (in CRR_market) viable_iff:
shows "viable_market Mkt  (d < 1+r  1+r < u)" using viable_if viable_only_if_d viable_only_if_u by auto


subsection ‹Risk-neutral probability space for the geometric random walk›



lemma (in CRR_market) stock_price_borel_measurable:
  shows "borel_adapt_stoch_proc G (prices Mkt stk)"
proof -
  have "borel_adapt_stoch_proc (stoch_proc_filt M geom_proc borel) (prices Mkt stk)"
    by (simp add: geom_rand_walk_borel_measurable stk_price stoch_proc_filt_adapt)
  thus ?thesis by (simp add:stock_filtration)
qed


lemma (in CRR_market) risk_free_asset_martingale:
  assumes "N = bernoulli_stream q"
  and "0 < q"
  and "q < 1"
  shows "martingale N G (discounted_value r (prices Mkt risk_free_asset))"
proof -
  have "filtration N G" by (simp add: assms bernoulli_gen_filtration)
  moreover have "n. sigma_finite_subalgebra N (G n)" by (simp add: assms bernoulli_sigma_finite)
  moreover have "finite_measure N" using assms bernoulli_stream_def prob_space.prob_space_stream_space
    prob_space_def prob_space_measure_pmf by auto
  moreover have "discounted_value r (prices Mkt risk_free_asset) = (λ n w. 1)" using discounted_rfr by auto
  ultimately show ?thesis using finite_measure.constant_martingale by simp
qed


lemma (in infinite_coin_toss_space) nat_filtration_from_eq_sets:
  assumes "N = bernoulli_stream q"
  and "0 < q"
  and "q < 1"
shows "sets (infinite_coin_toss_space.nat_filtration N n) = sets (nat_filtration n)"
proof -
  have "sigma_sets (space (bernoulli_stream q)) {pseudo_proj_True n -` B  space N |B. B  sets (bernoulli_stream q)} = sigma_sets (space (bernoulli_stream p))
          {pseudo_proj_True n -` B  space M |B. B  sets (bernoulli_stream p)}"
  proof -
    have "sets N = events"
      by (metis assms(1) bernoulli_stream_def infinite_coin_toss_space_axioms infinite_coin_toss_space_def sets_measure_pmf sets_stream_space_cong)
    then show ?thesis
      using assms(1) bernoulli_stream_space infinite_coin_toss_space_axioms infinite_coin_toss_space_def by auto
  qed
  thus ?thesis using infinite_coin_toss_space.nat_filtration_sets
    using assms(1) assms(2) assms(3) infinite_coin_toss_space_axioms infinite_coin_toss_space_def by auto
qed




lemma (in CRR_market) geom_proc_integrable:
  assumes "N = bernoulli_stream q"
and "0  q"
and "q  1"
shows "integrable N (geom_proc n)"
proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
  show "infinite_coin_toss_space q N" using assms by unfold_locales
  show "geom_proc n  borel_measurable (infinite_coin_toss_space.nat_filtration N n)" using geometric_process
    prob_grw.geom_rand_walk_borel_adapted[of q N geom_proc u d init]
    by (metis ‹infinite_coin_toss_space q N geom_rand_walk_pseudo_proj_True infinite_coin_toss_space.nat_filtration_borel_measurable_characterization
         prob_grw.geom_rand_walk_borel_measurable prob_grw_axioms prob_grw_def)
qed

lemma (in CRR_market) CRR_infinite_cts_filtration:
  shows "infinite_cts_filtration p M nat_filtration"
  by (unfold_locales, simp)


lemma (in CRR_market) proj_stoch_proc_geom_disc_fct:
  shows "disc_fct (proj_stoch_proc geom_proc n)" unfolding disc_fct_def using CRR_infinite_cts_filtration
    by (simp add: countable_finite geom_rand_walk_borel_adapted infinite_cts_filtration.proj_stoch_set_finite_range)

lemma (in CRR_market) proj_stoch_proc_geom_rng:
  assumes "N = bernoulli_stream q"
shows  "proj_stoch_proc geom_proc n  N M stream_space borel"
proof -
  have "random_variable (stream_space borel) (proj_stoch_proc geom_proc n)" using CRR_infinite_cts_filtration
    using geom_rand_walk_borel_adapted nat_discrete_filtration proj_stoch_measurable_if_adapted by blast
  then show ?thesis
    using assms(1) bernoulli bernoulli_stream_def by auto
qed

lemma (in CRR_market) proj_stoch_proc_geom_open_set:
  shows  "rrange (proj_stoch_proc geom_proc n)  space (stream_space borel).
     Asets (stream_space borel). range (proj_stoch_proc geom_proc n)  A = {r}"
proof
  fix r
  assume "r range (proj_stoch_proc geom_proc n)  space (stream_space borel)"
  show "Asets (stream_space borel). range (proj_stoch_proc geom_proc n)  A = {r}"
  proof
    show "infinite_cts_filtration.stream_space_single (proj_stoch_proc geom_proc n) r  sets (stream_space borel)"
      using infinite_cts_filtration.stream_space_single_set r  range (proj_stoch_proc geom_proc n)  space (stream_space borel)
        geom_rand_walk_borel_adapted CRR_infinite_cts_filtration by blast
    show "range (proj_stoch_proc geom_proc n)  infinite_cts_filtration.stream_space_single (proj_stoch_proc geom_proc n) r = {r}"
      using infinite_cts_filtration.stream_space_single_preimage r  range (proj_stoch_proc geom_proc n)  space (stream_space borel)
        geom_rand_walk_borel_adapted CRR_infinite_cts_filtration by blast
  qed
qed

lemma (in CRR_market) bernoulli_AE_cond_exp:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "integrable N X"
shows "AE w in N. real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) X w =
    expl_cond_expect N (proj_stoch_proc geom_proc n) X w"
proof (rule finite_measure.charact_cond_exp')
  have "infinite_cts_filtration p M nat_filtration"
    by (unfold_locales, simp)
  show "finite_measure N" using assms
    by (simp add: bernoulli_stream_def prob_space.finite_measure prob_space.prob_space_stream_space prob_space_measure_pmf)
  show "disc_fct (proj_stoch_proc geom_proc n)" using proj_stoch_proc_geom_disc_fct by simp
  show "integrable N X"  using assms by simp
  show "proj_stoch_proc geom_proc n  N M stream_space borel" using assms proj_stoch_proc_geom_rng by simp
  show "rrange (proj_stoch_proc geom_proc n)  space (stream_space borel).
     Asets (stream_space borel). range (proj_stoch_proc geom_proc n)  A = {r}"
    using proj_stoch_proc_geom_open_set by simp
qed

lemma (in CRR_market) geom_proc_cond_exp:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "AE w in N. real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) (geom_proc (Suc n)) w =
    expl_cond_expect N (proj_stoch_proc geom_proc n) (geom_proc (Suc n)) w"
proof (rule bernoulli_AE_cond_exp)
  show "integrable N (geom_proc (Suc n))"  using assms geom_proc_integrable[of N q "Suc n"] by simp
qed (auto simp add: assms)


lemma (in CRR_market) expl_cond_eq_sets:
  assumes "N = bernoulli_stream q"
  shows  "expl_cond_expect N (proj_stoch_proc geom_proc n) X 
        borel_measurable (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
proof (rule expl_cond_exp_borel)
  show "proj_stoch_proc geom_proc n  space N  space (stream_space borel)"
  proof -
    have "random_variable (stream_space borel) (proj_stoch_proc geom_proc n)"
      using CRR_infinite_cts_filtration geom_rand_walk_borel_adapted proj_stoch_measurable_if_adapted
        nat_discrete_filtration by blast
    then show ?thesis
      by (simp add: assms(1) bernoulli bernoulli_stream_space measurable_def)
  qed
  show "disc_fct (proj_stoch_proc geom_proc n)" unfolding disc_fct_def using CRR_infinite_cts_filtration
    by (simp add: countable_finite geom_rand_walk_borel_adapted infinite_cts_filtration.proj_stoch_set_finite_range)
  show "rrange (proj_stoch_proc geom_proc n)  space (stream_space borel).
    Asets (stream_space borel). range (proj_stoch_proc geom_proc n)  A = {r}"
  proof
    fix r
    assume "rrange (proj_stoch_proc geom_proc n)  space (stream_space borel)"
    show "Asets (stream_space borel). range (proj_stoch_proc geom_proc n)  A = {r}"
    proof
      show "infinite_cts_filtration.stream_space_single (proj_stoch_proc geom_proc n) r  sets (stream_space borel)"
        using infinite_cts_filtration.stream_space_single_set r  range (proj_stoch_proc geom_proc n)  space (stream_space borel)
          geom_rand_walk_borel_adapted CRR_infinite_cts_filtration by blast
      show "range (proj_stoch_proc geom_proc n)  infinite_cts_filtration.stream_space_single (proj_stoch_proc geom_proc n) r = {r}"
        using infinite_cts_filtration.stream_space_single_preimage r  range (proj_stoch_proc geom_proc n)  space (stream_space borel)
          geom_rand_walk_borel_adapted CRR_infinite_cts_filtration by blast
    qed
  qed
qed


lemma (in CRR_market) bernoulli_real_cond_exp_AE:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "integrable N X"
shows "real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))
   X w = expl_cond_expect N (proj_stoch_proc geom_proc n) X w"
proof -
  have "real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))
   X w = expl_cond_expect N (proj_stoch_proc geom_proc n) X w"
  proof (rule infinite_coin_toss_space.nat_filtration_AE_eq)
    show "infinite_coin_toss_space q N" using assms
      by (simp add: infinite_coin_toss_space_def)
    show "AE w in N. real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) X w =
    expl_cond_expect N (proj_stoch_proc geom_proc n) X w"  using assms bernoulli_AE_cond_exp by simp
    show "real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) X
       borel_measurable (infinite_coin_toss_space.nat_filtration N n)"
    proof -
      have "real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) X
         borel_measurable (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
        by simp
      moreover have "subalgebra (infinite_coin_toss_space.nat_filtration N n) (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
        using stock_filtration infinite_coin_toss_space.stoch_proc_subalg_nat_filt[of q N geom_proc n]
        infinite_cts_filtration.stoch_proc_filt_gen[of q N]
        by (metis ‹infinite_coin_toss_space q N infinite_cts_filtration_axioms.intro infinite_cts_filtration_def
            prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
      ultimately show ?thesis using measurable_from_subalg by blast
    qed
    show "expl_cond_expect N (proj_stoch_proc geom_proc n) X 
      borel_measurable (infinite_coin_toss_space.nat_filtration N n)"
    proof -
      have "expl_cond_expect N (proj_stoch_proc geom_proc n) X 
        borel_measurable (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
        by (simp add: expl_cond_eq_sets assms)
      moreover have "subalgebra (infinite_coin_toss_space.nat_filtration N n) (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
      using stock_filtration infinite_coin_toss_space.stoch_proc_subalg_nat_filt[of q N geom_proc n]
        infinite_cts_filtration.stoch_proc_filt_gen[of q N]
        by (metis ‹infinite_coin_toss_space q N infinite_cts_filtration_axioms.intro infinite_cts_filtration_def
            prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
      ultimately show ?thesis using measurable_from_subalg by blast
    qed
    show "0 < q" and "q < 1" using assms by auto
  qed
  thus ?thesis by simp
qed

lemma (in CRR_market) geom_proc_real_cond_exp_AE:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))
   (geom_proc (Suc n)) w = expl_cond_expect N (proj_stoch_proc geom_proc n) (geom_proc (Suc n)) w"
proof (rule bernoulli_real_cond_exp_AE)
show "integrable N (geom_proc (Suc n))"  using assms geom_proc_integrable[of N q "Suc n"] by simp
qed (auto simp add: assms)


lemma (in CRR_market) geom_proc_stoch_proc_filt:
  assumes "N= bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "stoch_proc_filt N geom_proc borel n = fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)"
proof (rule infinite_cts_filtration.stoch_proc_filt_gen)
  show "infinite_cts_filtration q N (infinite_coin_toss_space.nat_filtration N)" unfolding infinite_cts_filtration_def
  proof
    show "infinite_coin_toss_space q N" using assms
      by (simp add: infinite_coin_toss_space_def)
    show "infinite_cts_filtration_axioms N (infinite_coin_toss_space.nat_filtration N)"
      using infinite_cts_filtration_axioms_def by blast
  qed
  show "borel_adapt_stoch_proc (infinite_coin_toss_space.nat_filtration N) geom_proc"
    using ‹infinite_cts_filtration q N (infinite_coin_toss_space.nat_filtration N)
      prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def
    using infinite_cts_filtration_def by auto
qed

lemma (in CRR_market) bernoulli_cond_exp:
  assumes "N = bernoulli_stream q"
  and "0 < q"
  and "q < 1"
and "integrable N X"
shows "real_cond_exp N (stoch_proc_filt N geom_proc borel n) X w = expl_cond_expect N (proj_stoch_proc geom_proc n) X w"
proof -
  have aeq: "AE w in N. real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)) X w =
    expl_cond_expect N (proj_stoch_proc geom_proc n) X w"  using assms
    bernoulli_AE_cond_exp by simp
  have "w. real_cond_exp N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))
   X w = expl_cond_expect N (proj_stoch_proc geom_proc n) X w"  using assms bernoulli_real_cond_exp_AE by simp
  moreover have "stoch_proc_filt N geom_proc borel n = fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)"
    using assms geom_proc_stoch_proc_filt by simp
  ultimately show ?thesis by simp
qed

lemma (in CRR_market) stock_cond_exp:
  assumes "N = bernoulli_stream q"
  and "0 < q"
  and "q < 1"
shows "real_cond_exp N (stoch_proc_filt N geom_proc borel n) (geom_proc (Suc n)) w = expl_cond_expect N (proj_stoch_proc geom_proc n) (geom_proc (Suc n)) w"
proof (rule bernoulli_cond_exp)
show "integrable N (geom_proc (Suc n))"  using assms geom_proc_integrable[of N q "Suc n"] by simp
qed (auto simp add: assms)




lemma (in prob_space) discount_factor_real_cond_exp:
  assumes "integrable M X"
and "subalgebra M G"
and "-1 < r"
shows "AE w in M. real_cond_exp M G (λx. discount_factor r n x * X x) w = discount_factor r n w * (real_cond_exp M G X) w"
proof (rule sigma_finite_subalgebra.real_cond_exp_mult)
  show "sigma_finite_subalgebra M G" using assms subalgebra_sigma_finite by simp
  show "discount_factor r n  borel_measurable G" by (simp add: discount_factor_borel_measurable)
  show "random_variable borel X" using assms by simp
  show "integrable M (λx. discount_factor r n x * X x)"  using assms discounted_integrable[of M "λn. X"]
    unfolding discounted_value_def by simp
qed


lemma (in prob_space) discounted_value_real_cond_exp:
  assumes "integrable M X"
  and "-1 < r"
and "subalgebra M G"
  shows "AE w in M. real_cond_exp M G ((discounted_value r (λ m. X)) n) w =
    discounted_value r (λm. (real_cond_exp M G X)) n w" using  assms
  unfolding discounted_value_def  init_triv_filt_def filtration_def
  by (simp add: assms discount_factor_real_cond_exp)


lemma (in CRR_market)
  assumes "q = (1 + r - d)/(u -d)"
  and "viable_market Mkt"
  shows gt_param: "0 < q"
    and lt_param: "q < 1"
    and risk_neutral_param: "u * q + d * (1 - q) = 1 + r"
proof -
  show "0 < q" using  down_lt_up viable_only_if_d assms by simp
  show "q < 1" using down_lt_up viable_only_if_u assms by simp
  show "u * q + d * (1 - q) = 1 + r"
  proof -
    have "1 - q = 1 - (1 + r - d) / (u - d)" using assms by simp
    also have "... = (u - d)/(u - d) - (1 + r - d) / (u - d)" using down_lt_up by simp
    also have "... = (u - d - (1 + r - d))/(u-d)" using  diff_divide_distrib[of "u - d" "1 + r -d" "u -d"] by simp
    also have "... = (u - 1 - r)/(u-d)" by simp
    finally have "1 - q = (u - 1 - r)/(u -d)" .
    hence "u * q + d * (1 - q) = u * (1 + r - d)/(u - d) + d * (u - 1 - r)/(u - d)" using assms by simp
    also have "... = (u * (1 + r - d) + d * (u - 1 - r))/(u - d)" using add_divide_distrib[of "u * (1 + r - d)"] by simp
    also have "... = (u * (1 + r) - u * d + d * u - d * (1 + r))/(u - d)"
      by (simp add: diff_diff_add right_diff_distrib')
    also have "... = (u * (1+r) - d * (1+r))/(u - d)" by simp
    also have "... = ((u - d) * (1+r))/(u - d)" by (simp add: left_diff_distrib)
    also have "... = 1 + r" using down_lt_up by simp
    finally show ?thesis .
  qed
qed

lemma (in CRR_market) bernoulli_expl_cond_expect_adapt:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
  shows "expl_cond_expect N (proj_stoch_proc geom_proc n) f borel_measurable (G n)"
proof -
  have "sets N = sets M" using assms by (simp add: bernoulli bernoulli_stream_def sets_stream_space_cong)
  have icf: "infinite_cts_filtration p M nat_filtration" by (unfold_locales, simp)
  have "G n = stoch_proc_filt M geom_proc borel n" using stock_filtration by simp
  also have "... = fct_gen_subalgebra M (stream_space borel) (proj_stoch_proc geom_proc n)"
  proof (rule infinite_cts_filtration.stoch_proc_filt_gen)
    show "infinite_cts_filtration p M nat_filtration" using icf .
    show "borel_adapt_stoch_proc nat_filtration geom_proc" using geom_rand_walk_borel_adapted .
  qed
  also have "... = fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)"
    by (rule fct_gen_subalgebra_eq_sets, (simp add: ‹sets N = sets M))
  finally have "G n = fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n)" .
  moreover have "expl_cond_expect N (proj_stoch_proc geom_proc n) f 
    borel_measurable (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
    by (simp add: expl_cond_eq_sets assms)
  ultimately show ?thesis by simp
qed



lemma (in CRR_market) real_cond_exp_discount_stock:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "AE w in N. real_cond_exp N (G n)
   (discounted_value r (prices Mkt stk) (Suc n)) w =
                  discounted_value r (λm w. (q * u + (1 - q) * d) * prices Mkt stk n w) (Suc n) w"
proof -
  have qlt: "0 < q" and qgt: "q < 1" using assms by auto
  have "G n = (fct_gen_subalgebra M (stream_space borel)
                                (proj_stoch_proc geom_proc n))"
    using stock_filtration infinite_cts_filtration.stoch_proc_filt_gen[of p M nat_filtration geom_proc n] geometric_process
      geom_rand_walk_borel_adapted CRR_infinite_cts_filtration by simp
  also have "... = (fct_gen_subalgebra N (stream_space borel)
                                (proj_stoch_proc geom_proc n))"
  proof (rule fct_gen_subalgebra_eq_sets)
    show "events = sets N" using assms qlt qgt
      by (simp add: bernoulli bernoulli_stream_def sets_stream_space_cong)
  qed
  finally have "G n = (fct_gen_subalgebra N (stream_space borel)
                                (proj_stoch_proc geom_proc n))" .
  hence "AE w in N. real_cond_exp N (G n)
   (discounted_value r (prices Mkt stk) (Suc n)) w = real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
                                (proj_stoch_proc geom_proc n))
                                (discounted_value r (prices Mkt stk) (Suc n)) w" by simp
  moreover have "AE w in N. real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
                                (proj_stoch_proc geom_proc n))
                                (discounted_value r (prices Mkt stk) (Suc n)) w =
                            real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
                                (proj_stoch_proc geom_proc n))
                                (discounted_value r (λm. (prices Mkt stk) (Suc n)) (Suc n)) w"
  proof -
    have "w. (discounted_value r (prices Mkt stk) (Suc n)) w =
      (discounted_value r (λm. (prices Mkt stk) (Suc n)) (Suc n)) w"
    proof
      fix w
      show "discounted_value r (prices Mkt stk) (Suc n) w = discounted_value r (λm. prices Mkt stk (Suc n)) (Suc n) w"
        by (simp add: discounted_value_def)
    qed
    hence "(discounted_value r (prices Mkt stk) (Suc n)) =
      (discounted_value r (λm. (prices Mkt stk) (Suc n)) (Suc n))" by auto
    thus ?thesis by simp
    qed
  moreover have "AE w in N. (real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
                                (proj_stoch_proc geom_proc n))
                                (discounted_value r (λm. (prices Mkt stk) (Suc n)) (Suc n))) w =
               discounted_value r (λm. real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
                                                     (proj_stoch_proc geom_proc n))
                                                     ((prices Mkt stk) (Suc n))) (Suc n) w"
  proof (rule prob_space.discounted_value_real_cond_exp)
    show "-1 < r" using acceptable_rate by simp
    show "integrable N (prices Mkt stk (Suc n))" using stk_price geom_proc_integrable assms qlt qgt by simp
    show "subalgebra N (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc n))"
    proof (rule fct_gen_subalgebra_is_subalgebra)
      show "proj_stoch_proc geom_proc n  N M stream_space borel"
      proof -
        have "proj_stoch_proc geom_proc n  measurable M (stream_space borel)"
        proof (rule proj_stoch_measurable_if_adapted)
          show "borel_adapt_stoch_proc nat_filtration geom_proc" using
            geometric_process
            geom_rand_walk_borel_adapted by simp
          show "filtration M nat_filtration" using CRR_infinite_cts_filtration
            by (simp add: nat_discrete_filtration)
        qed
        thus ?thesis using assms bernoulli_stream_equiv filt_equiv_measurable qlt qgt psgt pslt by blast
      qed
    qed
    show "prob_space N" using assms
      by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
  qed
  moreover have "AE w in N. discounted_value r (λm. real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
                                                     (proj_stoch_proc geom_proc n))
                                                     ((prices Mkt stk) (Suc n))) (Suc n) w =
                    discounted_value r (λm w. (q * u + (1 - q) * d) * prices Mkt stk n w) (Suc n) w"
  proof (rule discounted_AE_cong)
   have "AEeq N (real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
                                (proj_stoch_proc geom_proc n))
                                ((prices Mkt stk) (Suc n)))
               (λw. q * (prices Mkt stk) (Suc n) (pseudo_proj_True n w) +
                (1 - q) * (prices Mkt stk) (Suc n) (pseudo_proj_False n w))"
     proof (rule infinite_cts_filtration.f_borel_Suc_real_cond_exp)
      show icf: "infinite_cts_filtration q N (infinite_coin_toss_space.nat_filtration N)" unfolding infinite_cts_filtration_def
      proof
        show "infinite_coin_toss_space q N" using assms qlt qgt
          by (simp add: infinite_coin_toss_space_def)
        show "infinite_cts_filtration_axioms N (infinite_coin_toss_space.nat_filtration N)"
          using infinite_cts_filtration_axioms_def by blast
      qed
      have badapt: "borel_adapt_stoch_proc (infinite_coin_toss_space.nat_filtration N) (prices Mkt stk)"
        using stk_price prob_grw.geom_rand_walk_borel_adapted[of q N  geom_proc]
        unfolding adapt_stoch_proc_def
        by (metis (full_types) borel_measurable_integrable geom_proc_integrable geom_rand_walk_pseudo_proj_True icf
            infinite_coin_toss_space.nat_filtration_borel_measurable_characterization infinite_coin_toss_space_def
            infinite_cts_filtration_def)
      show "prices Mkt stk (Suc n)  borel_measurable (infinite_coin_toss_space.nat_filtration N (Suc n))"
        using badapt unfolding adapt_stoch_proc_def by simp
      show "proj_stoch_proc geom_proc n  infinite_coin_toss_space.nat_filtration N n M stream_space borel"
      proof (rule proj_stoch_adapted_if_adapted)
        show "filtration N (infinite_coin_toss_space.nat_filtration N)" using icf
          using infinite_coin_toss_space.nat_discrete_filtration infinite_cts_filtration_def by blast
        show "borel_adapt_stoch_proc (infinite_coin_toss_space.nat_filtration N) geom_proc" using badapt stk_price by simp
      qed
      show "set_discriminating n (proj_stoch_proc geom_proc n) (stream_space borel)" unfolding set_discriminating_def
      proof (intro allI impI)
        fix w
        assume "proj_stoch_proc geom_proc n w  proj_stoch_proc geom_proc n (pseudo_proj_True n w)"
        hence False using CRR_infinite_cts_filtration
          by (metis ‹proj_stoch_proc geom_proc n w  proj_stoch_proc geom_proc n (pseudo_proj_True n w)
            geom_rand_walk_borel_adapted infinite_cts_filtration.proj_stoch_proj_invariant)
        thus "Asets (stream_space borel).
      (proj_stoch_proc geom_proc n w  A) = (proj_stoch_proc geom_proc n (pseudo_proj_True n w)  A)" by simp
      qed
      show "w. proj_stoch_proc geom_proc n -` {proj_stoch_proc geom_proc n w} 
        sets (infinite_coin_toss_space.nat_filtration N n)"
      proof
        fix w
        show "proj_stoch_proc geom_proc n -` {proj_stoch_proc geom_proc n w}  sets (infinite_coin_toss_space.nat_filtration N n)"
          using ‹proj_stoch_proc geom_proc n  infinite_coin_toss_space.nat_filtration N n M stream_space borel›
          using assms geom_rand_walk_borel_adapted nat_filtration_from_eq_sets   qlt qgt
            infinite_cts_filtration.proj_stoch_singleton_set CRR_infinite_cts_filtration by blast
      qed
      show "rrange (proj_stoch_proc geom_proc n)  space (stream_space borel).
        Asets (stream_space borel). range (proj_stoch_proc geom_proc n)  A = {r}"
      proof
        fix r
        assume asm: "r  range (proj_stoch_proc geom_proc n)  space (stream_space borel)"
        define A where "A = infinite_cts_filtration.stream_space_single (proj_stoch_proc geom_proc n) r"
        have "A  sets (stream_space borel)"  using infinite_cts_filtration.stream_space_single_set
          unfolding A_def using badapt icf stk_price asm by blast
        moreover have "range (proj_stoch_proc geom_proc n)  A = {r}"
          unfolding A_def using badapt icf stk_price infinite_cts_filtration.stream_space_single_preimage asm by blast
        ultimately show "Asets (stream_space borel). range (proj_stoch_proc geom_proc n)  A = {r}" by auto
      qed
      show "y z. proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z  y !! n = z !! n 
        prices Mkt stk (Suc n) y = prices Mkt stk (Suc n) z"
      proof (intro allI impI)
        fix y z
        assume "proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z  y !! n = z !! n"
        hence "geom_proc n y = geom_proc n z" using proj_stoch_proc_component(2)[of n n]
        proof -
          show ?thesis
            by (metis w f. n  n  proj_stoch_proc f n w !! n = f n w ‹proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z  y !! n = z !! n order_refl)
        qed
        hence "geom_proc (Suc n) y = geom_proc (Suc n) z" using geometric_process
          by (simp add: ‹proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z  y !! n = z !! n)
        thus "prices Mkt stk (Suc n) y = prices Mkt stk (Suc n) z" using stk_price by simp
      qed
      show "0 < q" and "q < 1" using assms by auto
    qed
    moreover have "w. q * prices Mkt stk (Suc n) (pseudo_proj_True n w) + (1 - q) * prices Mkt stk (Suc n) (pseudo_proj_False n w) =
      (q * u + (1 - q) * d) * prices Mkt stk n w"
    proof
      fix w
      have "q * prices Mkt stk (Suc n) (pseudo_proj_True n w) + (1 - q) * prices Mkt stk (Suc n) (pseudo_proj_False n w) =
        q * geom_proc (Suc n) (pseudo_proj_True n w) + (1-q) * geom_proc (Suc n) (pseudo_proj_False n w)"
        by (simp add:stk_price)
      also have "... = q * u * geom_proc n (pseudo_proj_True n w) + (1-q) * geom_proc (Suc n) (pseudo_proj_False n w)"
        using geometric_process unfolding pseudo_proj_True_def by simp
      also have "... = q * u * geom_proc n w + (1-q) * geom_proc (Suc n) (pseudo_proj_False n w)"
        by (metis geom_rand_walk_pseudo_proj_True o_apply)
      also have "... = q * u * geom_proc n w + (1-q) * d * geom_proc n (pseudo_proj_False n w)"
        using geometric_process unfolding pseudo_proj_False_def by simp
      also have "... = q * u * geom_proc n w + (1-q) * d * geom_proc n w"
        by (metis geom_rand_walk_pseudo_proj_False o_apply)
      also have "... = (q * u + (1 - q) * d) * geom_proc n w" by (simp add: distrib_right)
      finally show "q * prices Mkt stk (Suc n) (pseudo_proj_True n w) + (1 - q) * prices Mkt stk (Suc n) (pseudo_proj_False n w) =
        (q * u + (1 - q) * d) * prices Mkt stk n w" using stk_price by simp
    qed
    ultimately show "AEeq N (real_cond_exp N (fct_gen_subalgebra N (stream_space borel)
                                  (proj_stoch_proc geom_proc n))
                                  ((prices Mkt stk) (Suc n)))
                    (λw. (q * u + (1 - q) * d) * prices Mkt stk n w)" by simp
  qed
  ultimately show ?thesis by auto
qed



lemma (in CRR_market) risky_asset_martingale_only_if:
  assumes "N = bernoulli_stream q"
  and "0 < q"
  and "q < 1"
  and  "martingale N G (discounted_value r (prices Mkt stk))"
shows "q = (1 + r - d) / (u - d)"
proof -
  have "AE w in N. real_cond_exp N (G 0)
       (discounted_value r (prices Mkt stk) (Suc 0)) w =  discounted_value r (prices Mkt stk) 0 w" using assms
    unfolding martingale_def by simp
  hence "AE w in N. real_cond_exp N (G 0)
       (discounted_value r (prices Mkt stk) (Suc 0)) w =  prices Mkt stk 0 w" by (simp add: discounted_init)
  moreover have "AE w in N. real_cond_exp N (G 0) (discounted_value r (prices Mkt stk) (Suc 0)) w =
    discounted_value r (λm w. (q * u + (1 - q) * d) * prices Mkt stk 0 w) (Suc 0) w"
    using assms real_cond_exp_discount_stock by simp
  ultimately have "AE w in N. discounted_value r (λm w. (q * u + (1 - q) * d) * prices Mkt stk 0 w) (Suc 0) w =
    prices Mkt stk 0 w" by auto
  hence "AE w in N. discounted_value r (λm w. (q * u + (1 - q) * d) * init) (Suc 0) w =
    (λw. init) w" using stk_price geometric_process by simp
  hence "AE w in N. discount_factor r (Suc 0) w * (q * u + (1 - q) * d) * init =
    (λw. init) w" unfolding discounted_value_def by simp
  hence "AE w in N. (1+r) * discount_factor r (Suc 0) w * (q * u + (1 - q) * d) * init =
    (1+r) * (λw. init) w" by auto
  hence prev: "AE w in N. discount_factor r 0 w * (q * u + (1 - q) * d) * init =
    (1+r) * (λw. init) w" using discount_factor_times_rfr[of r 0] acceptable_rate
  proof -
    have "s. (1 + r) * discount_factor r (Suc 0) (s::bool stream) = discount_factor r 0 s"
    by (metis (no_types) w. - 1 < r  (1 + r) * discount_factor r (Suc 0) w = discount_factor r 0 w acceptable_rate)
    then show ?thesis
    using ‹AEeq N (λw. (1 + r) * discount_factor r (Suc 0) w * (q * u + (1 - q) * d) * init) (λw. (1 + r) * init) by presburger
  qed
  hence "w. (λw. discount_factor r 0 w * (q * u + (1 - q) * d) * init) w =
    (λw. (1+r) * init) w"
  proof -
    have "(λw. discount_factor r 0 w *  (q * u + (1 - q) * d) * init)
       borel_measurable (infinite_coin_toss_space.nat_filtration N 0)"
    proof (rule borel_measurable_times)+
      show "(λx. init)  borel_measurable (infinite_coin_toss_space.nat_filtration N 0)" by simp
      show "(λx. q * u + (1 - q) * d)  borel_measurable (infinite_coin_toss_space.nat_filtration N 0)" by simp
      show "discount_factor r 0  borel_measurable (infinite_coin_toss_space.nat_filtration N 0)"
        using discount_factor_nonrandom[of r 0 "infinite_coin_toss_space.nat_filtration N 0"] by simp
    qed
    moreover have "(λw. (1 + r) * init)  borel_measurable (infinite_coin_toss_space.nat_filtration N 0)" by simp
    moreover have "infinite_coin_toss_space q N" using assms by (simp add: infinite_coin_toss_space_def)
    ultimately show ?thesis
      using  prev infinite_coin_toss_space.nat_filtration_AE_eq[of q N
        "(λw. discount_factor r 0 w * (q * u + (1 - q) * d) * init)" "(λw. (1 + r) * init)" 0] assms
      by (simp add: discount_factor_init)
  qed
  hence "(q * u + (1 - q) * d) * init = (1+r) * init" by (simp add: discount_factor_init)
  hence "q * u + (1 - q) * d = 1+r" using S0_positive by simp
  hence "q * u + d - q * d = 1+r" by (simp add: left_diff_distrib)
  hence "q * (u - d) = 1 + r - d"
    by (metis (no_types, hide_lams) add.commute add.left_commute add_diff_cancel_left' add_uminus_conv_diff left_diff_distrib mult.commute)
  thus "q = (1 + r - d) / (u - d)" using down_lt_up
    by (metis add.commute add.right_neutral diff_add_cancel nonzero_eq_divide_eq order_less_irrefl)
qed



locale CRR_market_viable = CRR_market +
  assumes CRR_viable: "viable_market Mkt"


lemma (in CRR_market_viable) real_cond_exp_discount_stock_q_const:
  assumes "N = bernoulli_stream q"
and "q = (1+r-d) / (u-d)"
shows "AE w in N. real_cond_exp N (G n)
   (discounted_value r (prices Mkt stk) (Suc n)) w =
                  discounted_value r (prices Mkt stk) n w"
proof -
  have qlt: "0 < q" and qgt: "q < 1" using assms gt_param lt_param CRR_viable by auto
  have "AE w in N. real_cond_exp N (G n) (discounted_value r (prices Mkt stk) (Suc n)) w =
                  discounted_value r (λm w. (q * u + (1 - q) * d) * prices Mkt stk n w) (Suc n) w"
    using assms real_cond_exp_discount_stock[of N q] qlt qgt by simp
  moreover have "w. (q * u + (1 - q) * d) * prices Mkt stk n w =
    (1+r) * prices Mkt stk n w" using risk_neutral_param assms CRR_viable
      by (simp add: mult.commute)
  ultimately have "AE w in N. real_cond_exp N (G n) (discounted_value r (prices Mkt stk) (Suc n)) w =
                  discounted_value r (λm w. (1+r) * prices Mkt stk n w) (Suc n) w" by simp
  moreover have "w space N. discounted_value r (λm w. (1+r) * prices Mkt stk n w) (Suc n) w =
                     discounted_value r (λm w. prices Mkt stk n w) n w"
    using  acceptable_rate by (simp add:discounted_mult_times_rfr)
  moreover hence "w space N. discounted_value r (λm w. (1+r) * prices Mkt stk n w) (Suc n) w =
                     discounted_value r (prices Mkt stk) n w"
    using  acceptable_rate by (simp add:discounted_value_def)
  ultimately show "AE w in N. real_cond_exp N (G n) (discounted_value r (prices Mkt stk) (Suc n)) w =
                    discounted_value r (prices Mkt stk) n w" by simp
qed


lemma (in CRR_market_viable) risky_asset_martingale_if:
  assumes "N = bernoulli_stream q"
  and "q = (1 + r - d) / (u - d)"
shows "martingale N G (discounted_value r (prices Mkt stk))"
proof (rule disc_martingale_charact)
  have qlt: "0 < q" and qgt: "q < 1" using assms gt_param lt_param CRR_viable by auto
  show "n. integrable N (discounted_value r (prices Mkt stk) n)"
  proof
    fix n
    show "integrable N (discounted_value r (prices Mkt stk) n)"
    proof (rule discounted_integrable)
      show "space N = space M" using assms by (simp add: bernoulli bernoulli_stream_space)
      show "integrable N (prices Mkt stk n)"
      proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
        show "infinite_coin_toss_space q N" using assms qlt qgt
          by (simp add: infinite_coin_toss_space_def)
        show "prices Mkt stk n  borel_measurable (infinite_coin_toss_space.nat_filtration N n)"
          using geom_rand_walk_borel_adapted stk_price  nat_filtration_from_eq_sets unfolding adapt_stoch_proc_def
          by (metis ‹infinite_coin_toss_space q N borel_measurable_integrable geom_proc_integrable geom_rand_walk_pseudo_proj_True
              infinite_coin_toss_space.nat_filtration_borel_measurable_characterization infinite_coin_toss_space_def)
      qed
      show "-1 < r" using acceptable_rate by simp
    qed
  qed
  show "filtration N G" using qlt qgt by (simp add: bernoulli_gen_filtration assms)
  show "n. sigma_finite_subalgebra N (G n)" using qlt qgt by (simp add: assms bernoulli_sigma_finite)
  show "m. discounted_value r (prices Mkt stk) m  borel_measurable (G m)"
  proof
    fix m
    have "discounted_value r (λma. prices Mkt stk m) m  borel_measurable (G m)"
    proof (rule discounted_measurable)
      show "prices Mkt stk m  borel_measurable (G m)" using stock_price_borel_measurable
        unfolding adapt_stoch_proc_def by simp
    qed
    thus "discounted_value r (prices Mkt stk) m  borel_measurable (G m)"
      by (metis (mono_tags, lifting) discounted_value_def measurable_cong)
  qed
  show "n. AE w in N. real_cond_exp N (G n)
       (discounted_value r (prices Mkt stk) (Suc n)) w = discounted_value r (prices Mkt stk) n w"
  proof
    fix n
    show "AE w in N. real_cond_exp N (G n)
       (discounted_value r (prices Mkt stk) (Suc n)) w = discounted_value r (prices Mkt stk) n w"
      using assms real_cond_exp_discount_stock_q_const by simp
  qed
qed


lemma (in CRR_market_viable) risk_neutral_iff':
  assumes "N = bernoulli_stream q"
and "0  q"
and "q  1"
and "filt_equiv nat_filtration M N"
shows "rfr_disc_equity_market.risk_neutral_prob G Mkt r N  q= (1 + r - d) / (u - d)"
proof
  have "0 < q" and "q < 1" using assms filt_equiv_sgt filt_equiv_slt psgt pslt by auto note qprops = this
  have dem: "rfr_disc_equity_market M G Mkt r risk_free_asset"  by unfold_locales
  {
    assume "rfr_disc_equity_market.risk_neutral_prob G Mkt r N"
    hence "(prob_space N)  ( asset  stocks Mkt. martingale N G (discounted_value r (prices Mkt asset)))"
      using rfr_disc_equity_market.risk_neutral_prob_def[of M G Mkt] dem  by simp
    hence "martingale N G (discounted_value r (prices Mkt stk))" using stocks by simp
    thus "q = (1 + r - d) / (u - d)" using assms risky_asset_martingale_only_if[of N q] qprops by simp
  }
  {
    assume "q = (1 + r - d) / (u - d)"
    hence "martingale N G (discounted_value r (prices Mkt stk))" using risky_asset_martingale_if[of N q] assms by simp
    moreover have "martingale N G (discounted_value r (prices Mkt risk_free_asset))" using risk_free_asset_martingale
      assms qprops by simp
    ultimately show "rfr_disc_equity_market.risk_neutral_prob G Mkt r N" using stocks
      using assms(1) bernoulli_stream_def dem prob_space.prob_space_stream_space prob_space_measure_pmf
        rfr_disc_equity_market.risk_neutral_prob_def by fastforce
  }
qed

lemma (in CRR_market_viable) risk_neutral_iff:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "rfr_disc_equity_market.risk_neutral_prob G Mkt r N  q= (1 + r - d) / (u - d)"
  using bernoulli_stream_equiv assms risk_neutral_iff' psgt pslt by auto

subsection ‹Existence of a replicating portfolio›




fun (in CRR_market) rn_rev_price where
  "rn_rev_price N der matur 0 w = der w" |
  "rn_rev_price N der matur (Suc n) w = discount_factor r (Suc 0) w *
                                  expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (rn_rev_price N der matur n) w"






lemma (in CRR_market) stock_filtration_eq:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "G n = stoch_proc_filt N geom_proc borel n"
proof -
  have "G n= stoch_proc_filt M geom_proc borel n" using stock_filtration by simp
  also have "... = stoch_proc_filt N geom_proc borel n"
  proof (rule stoch_proc_filt_filt_equiv)
    show "filt_equiv nat_filtration M N" using assms bernoulli_stream_equiv psgt pslt by simp
  qed
  finally show ?thesis .
qed



lemma (in CRR_market) real_exp_eq:
  assumes "der borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "real_cond_exp N (stoch_proc_filt N geom_proc borel n) der w =
      expl_cond_expect N (proj_stoch_proc geom_proc n) der w"
proof -
  have "der  borel_measurable (nat_filtration matur)" using assms
      using geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
  have "integrable N der"
  proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
    show "infinite_coin_toss_space q N" using assms
      by (simp add: infinite_coin_toss_space_def)
    show "der  borel_measurable (infinite_coin_toss_space.nat_filtration N matur)"
      by (metis der  borel_measurable (nat_filtration matur) ‹infinite_coin_toss_space q N
          assms(2) assms(3) assms(4) infinite_coin_toss_space.nat_filtration_space measurable_from_subalg
          nat_filtration_from_eq_sets nat_filtration_space subalgebra_def subset_eq)
  qed
  show "real_cond_exp N (stoch_proc_filt N geom_proc borel n) der w =
    expl_cond_expect N (proj_stoch_proc geom_proc n) der w"
  proof (rule bernoulli_cond_exp)
    show "N = bernoulli_stream q" "0 < q" "q < 1" using assms by auto
    show "integrable N der" using ‹integrable N der .
  qed
qed

lemma (in CRR_market) rn_rev_price_rev_borel_adapt:
assumes "cash_flow  borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "(n  matur)  (rn_rev_price N cash_flow matur n)  borel_measurable (G (matur - n))"
proof (induct n)
case 0 thus ?case using assms by simp
next
  case (Suc n)
  have "rn_rev_price N cash_flow matur (Suc n) =
      (λw. discount_factor r (Suc 0) w *
        (expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (rn_rev_price N cash_flow matur n)) w)"
    using rn_rev_price.simps(2) by blast
  also have "...  borel_measurable (G (matur - Suc n))"
  proof (rule borel_measurable_times)
    show "discount_factor r (Suc 0)  borel_measurable (G (matur - Suc n))" by (simp add:discount_factor_borel_measurable)
    show "expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (rn_rev_price N cash_flow matur n)
       borel_measurable (G (matur - Suc n))" using assms by (simp add: bernoulli_expl_cond_expect_adapt)
  qed
  finally show "rn_rev_price N cash_flow matur (Suc n)  borel_measurable (G (matur - Suc n))" .
qed

lemma (in infinite_coin_toss_space) bernoulli_discounted_integrable:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
  and "der  borel_measurable (nat_filtration n)"
and "-1 < r"
  shows "integrable N (discounted_value r (λm. der) m)"
proof -
  have "prob_space N" using assms
    by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
  have "integrable N der"
  proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
    show "infinite_coin_toss_space q N" using assms
      by (simp add: infinite_coin_toss_space_def)
    show "der  borel_measurable (infinite_coin_toss_space.nat_filtration N n)"
      using assms filt_equiv_filtration
      by (simp add: assms(1) measurable_def nat_filtration_from_eq_sets nat_filtration_space)
  qed
  thus ?thesis using discounted_integrable assms
    by (metis ‹prob_space N prob_space.discounted_integrable)
qed



lemma (in CRR_market) rn_rev_expl_cond_expect:
  assumes "der borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
shows "n  matur  rn_rev_price N der matur n w =
  expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n) w"
proof (induct n arbitrary: w)
  case 0
  have "der  borel_measurable (nat_filtration matur)" using assms
      using geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
  have "integrable N der"
  proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
    show "infinite_coin_toss_space q N" using assms
      by (simp add: infinite_coin_toss_space_def)
    show "der  borel_measurable (infinite_coin_toss_space.nat_filtration N matur)"
      by (metis der  borel_measurable (nat_filtration matur) ‹infinite_coin_toss_space q N
          assms(2) assms(3) assms(4) infinite_coin_toss_space.nat_filtration_space measurable_from_subalg
          nat_filtration_from_eq_sets nat_filtration_space subalgebra_def subset_eq)
  qed
  have "rn_rev_price N der matur 0 w = der w" by simp
  also have "... = expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0) w"
  proof (rule nat_filtration_AE_eq)
    show "der  borel_measurable (nat_filtration matur)" using der  borel_measurable (nat_filtration matur) .
    have "(discounted_value r (λm. der) 0) = der" unfolding discounted_value_def discount_factor_def by simp
    moreover have "AEeq N (real_cond_exp N (G matur) der) der"
    proof (rule sigma_finite_subalgebra.real_cond_exp_F_meas)
      show "der  borel_measurable (G matur)" using assms by simp
      show "integrable N der" using ‹integrable N der .
      show "sigma_finite_subalgebra N (G matur)" using bernoulli_sigma_finite
        using assms by simp
    qed
    moreover have "w. real_cond_exp N (stoch_proc_filt N geom_proc borel matur) der w =
      expl_cond_expect N (proj_stoch_proc geom_proc matur) der w" using assms real_exp_eq by simp
    ultimately have eqn: "AEeq N der (expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0))"
      using stock_filtration_eq assms by auto
    have "stoch_proc_filt M geom_proc borel matur = stoch_proc_filt N geom_proc borel matur"
      using  bernoulli_stream_equiv[of N q] assms psgt pslt by (simp add: stoch_proc_filt_filt_equiv)
    also have "stoch_proc_filt N geom_proc borel matur =
      fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc matur)"
      using assms geom_proc_stoch_proc_filt by simp
    finally have "stoch_proc_filt M geom_proc borel matur =
      fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc matur)" .
    moreover have "expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0)
       borel_measurable (fct_gen_subalgebra N (stream_space borel) (proj_stoch_proc geom_proc matur))"
    proof (rule expl_cond_exp_borel)
      show "proj_stoch_proc geom_proc matur  space N  space (stream_space borel)"
        using assms proj_stoch_proc_geom_rng by (simp add: measurable_def)
      show "disc_fct (proj_stoch_proc geom_proc matur)" using proj_stoch_proc_geom_disc_fct by simp
      show "rrange (proj_stoch_proc geom_proc matur)  space (stream_space borel).
        Asets (stream_space borel). range (proj_stoch_proc geom_proc matur)  A = {r}"
        using proj_stoch_proc_geom_open_set by simp
    qed
    ultimately show ebm: "expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0)
       borel_measurable (nat_filtration matur)"
      by (metis geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt)
    show "AEeq M der (expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0))"
    proof (rule filt_equiv_borel_AE_eq_iff[THEN iffD2])
      show "filt_equiv nat_filtration M N" using assms bernoulli_stream_equiv psgt pslt by simp
      show "der  borel_measurable (nat_filtration matur)" using der  borel_measurable (nat_filtration matur) .
      show "AEeq N der (expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0))"
        using eqn .
      show "expl_cond_expect N (proj_stoch_proc geom_proc matur) (discounted_value r (λm. der) 0)
         borel_measurable (nat_filtration matur)" using ebm .
      show "prob_space N" using assms by (simp add: bernoulli_stream_def
            prob_space.prob_space_stream_space prob_space_measure_pmf)
      show "prob_space M" by (simp add: bernoulli bernoulli_stream_def
            prob_space.prob_space_stream_space prob_space_measure_pmf)
    qed
    show "0 < p" "p < 1" using psgt pslt by auto
  qed
  also have "... = expl_cond_expect N (proj_stoch_proc geom_proc (matur - 0)) (discounted_value r (λm. der) 0) w"
    by simp
  finally show "rn_rev_price N der matur 0 w =
    expl_cond_expect N (proj_stoch_proc geom_proc (matur - 0)) (discounted_value r (λm. der) 0) w" .
next
  case (Suc n)
  have "rn_rev_price N der matur (Suc n) w = discount_factor r (Suc 0) w *
          expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (rn_rev_price N der matur n) w" by simp
  also have "... = discount_factor r (Suc 0) w *
    real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (rn_rev_price N der matur n) w"
  proof -
    have "expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (rn_rev_price N der matur n) w =
     real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (rn_rev_price N der matur n) w"
    proof (rule real_exp_eq[symmetric])
      show "rn_rev_price N der matur n  borel_measurable (G (matur - n))"
        using assms rn_rev_price_rev_borel_adapt Suc by simp
      show "N = bernoulli_stream q" "0 < q" "q < 1" using assms by auto
    qed
    thus ?thesis by simp
  qed
  also have "... = discount_factor r (Suc 0) w *
    real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
    (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)) w"
  proof -
    have "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (rn_rev_price N der matur n) w =
      real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
    (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)) w"
    proof (rule infinite_coin_toss_space.nat_filtration_AE_eq)
      show "AEeq N (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (rn_rev_price N der matur n))
        (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
        (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)))"
      proof (rule sigma_finite_subalgebra.real_cond_exp_cong)
        show "sigma_finite_subalgebra N (stoch_proc_filt N geom_proc borel (matur - Suc n))"
          using assms(2) assms(3) assms(4) bernoulli_sigma_finite stock_filtration_eq by auto
        show "rn_rev_price N der matur n  borel_measurable N"
        proof -
          have "rn_rev_price N der matur n  borel_measurable (G (matur - n))"
            by (metis (full_types) Suc.prems Suc_leD assms(1) assms(2) assms(3) assms(4) rn_rev_price_rev_borel_adapt)
          then show ?thesis
            by (metis (no_types) assms(2) bernoulli bernoulli_stream_def filtration_measurable measurable_cong_sets sets_measure_pmf sets_stream_space_cong)
        qed
        show "expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)  borel_measurable N"
          using Suc.hyps Suc.prems Suc_leD ‹rn_rev_price N der matur n  borel_measurable N by presburger
        show "AEeq N (rn_rev_price N der matur n)
          (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n))" using Suc by auto
      qed
      show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (rn_rev_price N der matur n)
         borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
        by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
            infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
            prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
      show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
         (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n))
         borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
        by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
              infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
              prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
      show "0 < q" "q < 1" using assms by auto
      show "infinite_coin_toss_space q N" using assms
        by (simp add: infinite_coin_toss_space_def)
    qed
    thus ?thesis by simp
  qed
  also have "... = discount_factor r (Suc 0) w *
  real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
   (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) w"
  proof -
    have "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
      (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)) w =
      real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
      (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) w"
    proof (rule infinite_coin_toss_space.nat_filtration_AE_eq)
      show "AEeq N (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
             (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)))
         (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
           (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)))"
      proof (rule sigma_finite_subalgebra.real_cond_exp_cong)
        show "sigma_finite_subalgebra N (stoch_proc_filt N geom_proc borel (matur - Suc n))"
          using assms(2) assms(3) assms(4) bernoulli_sigma_finite stock_filtration_eq by auto
        show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)  borel_measurable N"
          by simp
        show "expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)  borel_measurable N"
          by (metis assms(2) assms(3) assms(4) bernoulli bernoulli_expl_cond_expect_adapt bernoulli_stream_def filtration_measurable
              measurable_cong_sets sets_measure_pmf sets_stream_space_cong)
        show "AEeq N (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n))
          (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n))"
        proof -
          have "discounted_value r (λm. der) n  borel_measurable (G matur)" using assms discounted_measurable[of der]
            by simp
          hence "w. (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n)) w =
            (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) w"
            using real_exp_eq[of _ matur N q "matur-n"] assms by simp
          thus ?thesis by simp
        qed
      qed
      show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
         (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n))
         borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
        by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
              infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
              prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
      show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
         (expl_cond_expect N (proj_stoch_proc geom_proc (matur - n)) (discounted_value r (λm. der) n))
         borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
        by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
              infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
              prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
      show "0 < q" "q < 1" using assms by auto
      show "infinite_coin_toss_space q N" using assms
        by (simp add: infinite_coin_toss_space_def)
    qed
    thus ?thesis by simp
  qed
  also have "... = real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
    (discounted_value r (λm. der) (Suc n)) w"
  proof (rule infinite_coin_toss_space.nat_filtration_AE_eq)
    show "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) (Suc n))
       borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
        by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
              infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
              prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
      show "(λa. discount_factor r (Suc 0) a *
          real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
           (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) a)
         borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
      proof -
        have "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
           (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n))
         borel_measurable (infinite_coin_toss_space.nat_filtration N (matur - Suc n))"
        by (metis assms(2) assms(3) assms(4) borel_measurable_cond_exp infinite_coin_toss_space.intro
              infinite_coin_toss_space.stoch_proc_subalg_nat_filt linear measurable_from_subalg not_less
              prob_grw.geom_rand_walk_borel_adapted prob_grw_axioms prob_grw_def)
      thus ?thesis using discounted_measurable[of "real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
        (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n))"]
        unfolding discounted_value_def by simp
    qed
    show "0 < q" "q < 1" using assms by auto
    show "infinite_coin_toss_space q N" using assms
      by (simp add: infinite_coin_toss_space_def)
    show "AEeq N (λw. discount_factor r (Suc 0) w *
                 real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
                  (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) w)
     (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) (Suc n)))"
    proof-
      have "AEeq N
        (λw. discount_factor r (Suc 0) w *
                 real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
                  (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)) w)
        (λw. discount_factor r (Suc 0) w *
                 real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) n) w)"
      proof -
        have "AEeq N (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
                  (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - n)) (discounted_value r (λm. der) n)))
                (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) n))"
        proof (rule sigma_finite_subalgebra.real_cond_exp_nested_subalg)
          show "sigma_finite_subalgebra N (stoch_proc_filt N geom_proc borel (matur - Suc n))"
            using assms(2) assms(3) assms(4) bernoulli_sigma_finite stock_filtration_eq by auto
          show "subalgebra N (stoch_proc_filt N geom_proc borel (matur - n))"
            using assms(2) assms(3) assms(4) bernoulli_sigma_finite sigma_finite_subalgebra.subalg
              stock_filtration_eq by fastforce
          show "subalgebra (stoch_proc_filt N geom_proc borel (matur - n)) (stoch_proc_filt N geom_proc borel (matur - Suc n))"
          proof -
            have "init_triv_filt M (stoch_proc_filt M geom_proc borel)" using infinite_cts_filtration.stoch_proc_filt_triv_init
              using info_filtration stock_filtration by auto
            moreover have "matur - (Suc n)  matur - n" by simp
            ultimately show ?thesis unfolding init_triv_filt_def filtration_def
              using assms(2) assms(3) assms(4) stock_filtration stock_filtration_eq by auto
          qed
          show "integrable N (discounted_value r (λm. der) n) " using bernoulli_discounted_integrable[of N q der matur r n] acceptable_rate assms
            using geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
        qed
        thus ?thesis  by auto
      qed
      moreover have "AEeq N
        (λw. discount_factor r (Suc 0) w *
         real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) n) w)
        (λw. discount_factor r (Suc 0) w * (discounted_value r
         (λm. real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) der) n) w)"
      proof -
        have "AEeq N (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) (discounted_value r (λm. der) n))
          (discounted_value r
         (λm. real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) der) n)"
        proof (rule prob_space.discounted_value_real_cond_exp)
          show "prob_space N" using assms
            by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
          have "der  borel_measurable (nat_filtration matur)" using assms
            using geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
          show "integrable N der"
          proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
            show "infinite_coin_toss_space q N" using assms
              by (simp add: infinite_coin_toss_space_def)
            show "der  borel_measurable (infinite_coin_toss_space.nat_filtration N matur)"
              by (metis der  borel_measurable (nat_filtration matur) ‹infinite_coin_toss_space q N
                  assms(2) assms(3) assms(4) infinite_coin_toss_space.nat_filtration_space measurable_from_subalg
                  nat_filtration_from_eq_sets nat_filtration_space subalgebra_def subset_eq)
          qed
          show "-1 < r" using acceptable_rate .
          show "subalgebra N (stoch_proc_filt N geom_proc borel (matur - Suc n))"
            using assms(2) assms(3) assms(4) bernoulli_sigma_finite sigma_finite_subalgebra.subalg
              stock_filtration_eq by fastforce
        qed
        thus ?thesis  by auto
      qed
      moreover have "w. (λw. discount_factor r (Suc 0) w * (discounted_value r
         (λm. real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) der) n) w) w =
        (discounted_value r
         (λm. real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) der) (Suc n)) w"
        unfolding discounted_value_def discount_factor_def  by simp
      moreover have "AEeq N
        (real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n))
        (discounted_value r (λm. der) (Suc n)))
        (discounted_value r
        (λm. real_cond_exp N (stoch_proc_filt N geom_proc borel (matur - Suc n)) der) (Suc n))"
      proof (rule prob_space.discounted_value_real_cond_exp)
        show "prob_space N" using assms
            by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
        have "der  borel_measurable (nat_filtration matur)" using assms
          using geom_rand_walk_borel_adapted measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
        show "integrable N der"
        proof (rule infinite_coin_toss_space.nat_filtration_borel_measurable_integrable)
          show "infinite_coin_toss_space q N" using assms
            by (simp add: infinite_coin_toss_space_def)
          show "der  borel_measurable (infinite_coin_toss_space.nat_filtration N matur)"
            by (metis der  borel_measurable (nat_filtration matur) ‹infinite_coin_toss_space q N
                assms(2) assms(3) assms(4) infinite_coin_toss_space.nat_filtration_space measurable_from_subalg
                nat_filtration_from_eq_sets nat_filtration_space subalgebra_def subset_eq)
        qed
        show "-1 < r" using acceptable_rate .
        show "subalgebra N (stoch_proc_filt N geom_proc borel (matur - Suc n))"
          using assms(2) assms(3) assms(4) bernoulli_sigma_finite sigma_finite_subalgebra.subalg
            stock_filtration_eq by fastforce
      qed
      ultimately show ?thesis by auto
    qed
  qed
  also have "... = expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n))
    (discounted_value r (λm. der) (Suc n)) w"
  proof (rule real_exp_eq)
    show "discounted_value r (λm. der) (Suc n)  borel_measurable (G matur)" using assms discounted_measurable[of der]
      by simp
    show "N = bernoulli_stream q" "0 < q" "q < 1" using assms by auto
  qed
  finally show "rn_rev_price N der matur (Suc n) w =
    expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc n)) (discounted_value r (λm. der) (Suc n)) w" .
qed

definition (in CRR_market) rn_price where
"rn_price N der matur n w = expl_cond_expect N (proj_stoch_proc geom_proc n) (discounted_value r (λm. der) (matur - n)) w"


definition (in CRR_market) rn_price_ind where
"rn_price_ind N der matur n w = rn_rev_price N der matur (matur - n) w"

lemma (in CRR_market) rn_price_eq:
  assumes "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "der  borel_measurable (G matur)"
and "n  matur"
shows "rn_price N der matur n w = rn_price_ind N der matur n w" using rn_rev_expl_cond_expect
  unfolding rn_price_def rn_price_ind_def
  by (simp add: assms)


lemma (in CRR_market) geom_proc_filt_info:
  fixes f::"bool stream  'b::{t0_space}"
  assumes "f  borel_measurable (G n)"
  shows "f w = f (pseudo_proj_True n w)"
proof -
  have "subalgebra (nat_filtration n) (G n)" using stoch_proc_subalg_nat_filt[of geom_proc n] geometric_process
    stock_filtration geom_rand_walk_borel_adapted by simp
  hence "f borel_measurable (nat_filtration n)" using assms by (simp add: measurable_from_subalg)
  thus ?thesis using nat_filtration_info[of f n] by (metis comp_apply)
qed

lemma (in CRR_market) geom_proc_filt_info':
  fixes f::"bool stream  'b::{t0_space}"
  assumes "f  borel_measurable (G n)"
  shows "f w = f (pseudo_proj_False n w)"
proof -
  have "subalgebra (nat_filtration n) (G n)" using stoch_proc_subalg_nat_filt[of geom_proc n] geometric_process
    stock_filtration geom_rand_walk_borel_adapted by simp
  hence "f borel_measurable (nat_filtration n)" using assms by (simp add: measurable_from_subalg)
  thus ?thesis using nat_filtration_info'[of f n] by (metis comp_apply)
qed




lemma (in CRR_market) rn_price_borel_adapt:
assumes "cash_flow  borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
and "n  matur"
shows "(rn_price N cash_flow matur n)  borel_measurable (G n)"
proof -
  show "(rn_price N cash_flow matur n)  borel_measurable (G n)"
    using assms rn_rev_price_rev_borel_adapt[of cash_flow matur N q "matur - n"] rn_price_eq rn_price_ind_def
    by (smt add.right_neutral cancel_comm_monoid_add_class.diff_cancel diff_commute diff_le_self
        increasing_measurable_info measurable_cong nat_le_linear ordered_cancel_comm_monoid_diff_class.add_diff_inverse)
qed


definition (in CRR_market) delta_price where
  "delta_price N cash_flow T =
    (λ n w. if (Suc n  T)
      then (rn_price N cash_flow T (Suc n) (pseudo_proj_True n w) - rn_price N cash_flow T (Suc n) (pseudo_proj_False n w))/
        (geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False))
      else 0)"


lemma (in CRR_market) delta_price_eq:
  assumes "Suc n  T"
  shows "delta_price N cash_flow T n w = (rn_price N cash_flow T (Suc n) (spick w n True) - rn_price N cash_flow T (Suc n) (spick w n False))/
    ((geom_proc n w) * (u - d))"
proof -
  have "(geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False)) = geom_proc n w * (u - d)"
    by (simp add: geom_rand_walk_diff_induct)
  then show ?thesis unfolding delta_price_def using assms spick_eq_pseudo_proj_True spick_eq_pseudo_proj_False by simp
qed



lemma (in CRR_market) geom_proc_spick:
  shows "geom_proc (Suc n) (spick w n x)  = (if x then u else d) * geom_proc n w"
proof -
  have "geom_proc (Suc n) (spick w n x)  = geom_rand_walk u d init (Suc n) (spick w n x)" using geometric_process by simp
  also have "... = (case (spick w n x) !! n of True  u | False  d) * geom_rand_walk u d init n (spick w n x)"
    by simp
  also have "... = (case x of True  u | False  d) * geom_rand_walk u d init n (spick w n x)"
    unfolding spick_def by simp
  also have "... = (if x then u else d) * geom_rand_walk u d init n (spick w n x)" by simp
  also have "... = (if x then u else d) * geom_rand_walk u d init n w"
    by (metis comp_def geom_rand_walk_pseudo_proj_True geometric_process pseudo_proj_True_stake_image spickI)
  finally show ?thesis using geometric_process by simp
qed


lemma (in CRR_market) spick_red_geom:
  shows "(λw. spick w n x)  measurable (fct_gen_subalgebra M borel (geom_proc n)) (fct_gen_subalgebra M borel (geom_proc (Suc n)))"
  unfolding measurable_def
proof (intro CollectI conjI)
  show "(λw. spick w n x)
     space (fct_gen_subalgebra M borel (geom_proc n))  space (fct_gen_subalgebra M borel (geom_proc (Suc n)))"
    by (simp add: bernoulli bernoulli_stream_space fct_gen_subalgebra_space)
  show "ysets (fct_gen_subalgebra M borel (geom_proc (Suc n))).
       (λw. spick w n x) -` y  space (fct_gen_subalgebra M borel (geom_proc n))
        sets (fct_gen_subalgebra M borel (geom_proc n))"
  proof
    fix A
    assume A: "A  sets (fct_gen_subalgebra M borel (geom_proc (Suc n)))"
    show "(λw. spick w n x) -` A  space (fct_gen_subalgebra M borel (geom_proc n)) 
    sets (fct_gen_subalgebra M borel (geom_proc n))"
    proof -
      define sp where "sp = (λw. spick w n x)"
      have "A  {(geom_proc (Suc n)) -` B  space M |B. B  sets borel}" using A
        by (simp add:fct_gen_subalgebra_sigma_sets)
      from this obtain C where "C sets borel" and "A = (geom_proc (Suc n)) -`C  space M" by auto
      hence "A = (geom_proc (Suc n)) -`C" using bernoulli bernoulli_stream_space by simp
      hence "sp -`A = sp -` (geom_proc (Suc n)) -`C" by simp
      also have "... = (geom_proc (Suc n)  sp) -` C" by auto
      also have "... = (λw. (if x then u else d) * geom_proc n w) -` C" using geom_proc_spick
        sp_def by auto
      also have "...  sets (fct_gen_subalgebra M borel (geom_proc n))"
      proof (cases x)
        case True
        hence "(λw. (if x then u else d) * geom_proc n w) -` C = (λw. u * geom_proc n w) -` C" by simp
        moreover have "(λw. u * geom_proc n w)  borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
        proof -
          have "geom_proc n borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
            using fct_gen_subalgebra_fct_measurable
            by (metis (no_types, lifting) geom_rand_walk_borel_measurable measurable_def mem_Collect_eq)
          thus ?thesis by simp
        qed
        ultimately show ?thesis using C sets borel›
          by (metis bernoulli bernoulli_stream_preimage fct_gen_subalgebra_space measurable_sets)
      next
        case False
        hence "(λw. (if x then u else d) * geom_proc n w) -` C = (λw. d * geom_proc n w) -` C" by simp
        moreover have "(λw. d * geom_proc n w)  borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
        proof -
          have "geom_proc n borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
            using fct_gen_subalgebra_fct_measurable
            by (metis (no_types, lifting) geom_rand_walk_borel_measurable measurable_def mem_Collect_eq)
          thus ?thesis by simp
        qed
        ultimately show ?thesis using C sets borel›
          by (metis bernoulli bernoulli_stream_preimage fct_gen_subalgebra_space measurable_sets)
      qed
      finally show ?thesis unfolding sp_def by (simp add: bernoulli bernoulli_stream_space fct_gen_subalgebra_space)
    qed
  qed
qed

lemma (in CRR_market) geom_spick_Suc:
  assumes "A  {(geom_proc (Suc n)) -` B |B. B  sets borel}"
  shows "(λw. spick w n x) -`A  {geom_proc n -`B | B. B sets borel}"
proof -
  have "sets (fct_gen_subalgebra M borel (geom_proc n)) = {geom_proc n -` B space M |B. B  sets borel}"
    by (simp add: fct_gen_subalgebra_sigma_sets)
  also have "... =  {geom_proc n -` B |B. B  sets borel}" using bernoulli bernoulli_stream_space by simp
  finally have sf: "sets (fct_gen_subalgebra M borel (geom_proc n)) = {geom_proc n -` B |B. B  sets borel}" .
  define sp where "sp = (λw. spick w n x)"
  from assms(1) obtain C where "C sets borel" and "A = (geom_proc (Suc n)) -`C" by auto
  hence "A = (geom_proc (Suc n)) -`C" using bernoulli bernoulli_stream_space by simp
  hence "sp -`A = sp -` (geom_proc (Suc n)) -`C" by simp
  also have "... = (geom_proc (Suc n)  sp) -` C" by auto
  also have "... = (λw. (if x then u else d) * geom_proc n w) -` C" using geom_proc_spick
    sp_def by auto
  also have "...  {geom_proc n -`B | B. B sets borel}"
  proof (cases x)
    case True
    hence "(λw. (if x then u else d) * geom_proc n w) -` C = (λw. u * geom_proc n w) -` C" by simp
    moreover have "(λw. u * geom_proc n w)  borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
    proof -
      have "geom_proc n borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
        using fct_gen_subalgebra_fct_measurable
        by (metis (no_types, lifting) geom_rand_walk_borel_measurable measurable_def mem_Collect_eq)
      thus ?thesis by simp
    qed
    ultimately show ?thesis using C sets borel› sf
      by (simp add: bernoulli bernoulli_stream_preimage fct_gen_subalgebra_space in_borel_measurable_borel)
  next
    case False
    hence "(λw. (if x then u else d) * geom_proc n w) -` C = (λw. d * geom_proc n w) -` C" by simp
    moreover have "(λw. d * geom_proc n w)  borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
    proof -
      have "geom_proc n borel_measurable (fct_gen_subalgebra M borel (geom_proc n))"
        using fct_gen_subalgebra_fct_measurable
        by (metis (no_types, lifting) geom_rand_walk_borel_measurable measurable_def mem_Collect_eq)
      thus ?thesis by simp
    qed
    ultimately show ?thesis using C sets borel› sf
      by (simp add: bernoulli bernoulli_stream_preimage fct_gen_subalgebra_space in_borel_measurable_borel)
  qed
  finally show ?thesis unfolding sp_def .
qed


lemma (in CRR_market) geom_spick_lt:
  assumes "m< n"
  shows "geom_proc m (spick w n x) = geom_proc m w"
proof -
  have "geom_proc m (spick w n x) = geom_proc m (pseudo_proj_True m (spick w n x))"
    using  geom_rand_walk_pseudo_proj_True by (metis comp_apply)
  also have "... = geom_proc m (pseudo_proj_True m w)" using assms
    by (metis less_imp_le_nat pseudo_proj_True_def pseudo_proj_True_prefix spickI)
  also have "... = geom_proc m w" using  geom_rand_walk_pseudo_proj_True by (metis comp_apply)
  finally show ?thesis .
qed

lemma (in CRR_market) geom_spick_eq:
  shows "geom_proc m (spick w m x) = geom_proc m w"
proof (cases x)
  case True
  have "geom_proc m (spick w m x) = geom_proc m (pseudo_proj_True m (spick w m x))"
    using  geom_rand_walk_pseudo_proj_True by (metis comp_apply)
  also have "... = geom_proc m (pseudo_proj_True m w)" using True
    by (metis pseudo_proj_True_def spickI)
  also have "... = geom_proc m w" using  geom_rand_walk_pseudo_proj_True by (metis comp_apply)
  finally show ?thesis .
next
  case False
  have "geom_proc m (spick w m x) = geom_proc m (pseudo_proj_False m (spick w m x))"
    using  geom_rand_walk_pseudo_proj_False by (metis comp_apply)
  also have "... = geom_proc m (pseudo_proj_False m w)" using False
    by (metis pseudo_proj_False_def spickI)
  also have "... = geom_proc m w" using  geom_rand_walk_pseudo_proj_False by (metis comp_apply)
  finally show ?thesis .
qed


lemma (in CRR_market) spick_red_geom_filt:
  shows "(λw. spick w n x)  measurable (G n) (G (Suc n))" unfolding measurable_def
proof (intro CollectI conjI)
  show "(λw. spick w n x)  space (G n)  space (G (Suc n))" using stock_filtration
    by (simp add: bernoulli bernoulli_stream_space stoch_proc_filt_space)
  show "ysets (G (Suc n)). (λw. spick w n x) -` y  space (G n)  sets (G n)"
  proof
    fix B
    assume "B sets (G (Suc n))"
    hence "B (sigma_sets (space M) ( i {m. m (Suc n)}. {(geom_proc i -`A)  (space M) | A. A sets borel }))"
      using stock_filtration stoch_proc_filt_sets geometric_process
    proof -
      have "n. sigma_sets (space M) (n{na. na  n}. {geom_proc n -` R  space M |R. R  sets borel}) = sets (G n)"
        by (simp add: geom_rand_walk_borel_measurable stoch_proc_filt_sets stock_filtration)
      then show ?thesis
        using B  sets (G (Suc n)) by blast
    qed
    hence "(λw. spick w n x) -` B  sets (G n)"
    proof (induct rule:sigma_sets.induct)
      {
        fix C
        assume "C  (i{m. m  Suc n}. {geom_proc i -` A  space M |A. A  sets borel})"
        hence "m  Suc n. C {geom_proc m -` A  space M |A. A  sets borel}" by auto
        from this obtain m where "m Suc n" and "C {geom_proc m -` A  space M |A. A  sets borel}" by auto
        note Cprops = this
        from this obtain D where "C = geom_proc m -` D space M" and "D sets borel" by auto
        hence "C = geom_proc m -`D" using bernoulli bernoulli_stream_space by simp
        have "C {geom_proc m -` A |A. A  sets borel}" using bernoulli bernoulli_stream_space Cprops by simp
        show "(λw. spick w n x) -` C  sets (G n)"
        proof (cases "m  n")
          case True
          have "(λw. spick w n x) -` C = (λw. spick w n x) -` geom_proc m -`D" using C = geom_proc m -`D by simp
          also have "... = (geom_proc m  (λw. spick w n x)) -`D" by auto
          also have "... = geom_proc m -`D" using geom_spick_lt geom_spick_eq mn
            using le_eq_less_or_eq by auto
          also have "...  sets (G n)" using stock_filtration geometric_process
            D sets borel›
            by (metis (no_types, lifting) True adapt_stoch_proc_def bernoulli bernoulli_stream_preimage
                geom_rand_walk_borel_measurable increasing_measurable_info measurable_sets stoch_proc_filt_adapt
                stoch_proc_filt_space)
          finally show "(λw. spick w n x) -` C  sets (G n)" .
        next
          case False
          hence "m = Suc n" using m  Suc n by simp
          hence "(λw. spick w n x) -` C  {geom_proc n -` B |B. B  sets borel}"
            using C {geom_proc m -` A |A. A  sets borel} geom_spick_Suc by simp
          also have "...  sets (G n)"
          proof -
            have "{geom_proc n -` B |B. B  sets borel}  {geom_proc n -` B  space M |B. B  sets borel}"
              using bernoulli bernoulli_stream_space by simp
            also have "...  (i{m. m  n}. {geom_proc i -` A  space M |A. A  sets borel})"
               by auto
            also have "...   sigma_sets (space M) (i{m. m  n}. {geom_proc i -` A  space M |A. A  sets borel})"
              by (rule sigma_sets_superset_generator)
            also have "... = sets (G n)" using stock_filtration geometric_process
              stoch_proc_filt_sets[of n geom_proc M borel] geom_rand_walk_borel_measurable by blast
            finally show ?thesis .
          qed
          finally show ?thesis .
        qed
      }
      show "(λw. spick w n x) -` {}  sets (G n)" by simp
      {
        fix C
        assume "C  sigma_sets (space M) (i{m. m  Suc n}. {geom_proc i -` A  space M |A. A  sets borel})"
          and "(λw. spick w n x) -` C  sets (G n)"
        hence "(λw. spick w n x) -` (space M - C) = (λw. spick w n x) -` (space M) - (λw. spick w n x) -` C"
          by (simp add: vimage_Diff)
        also have "... = space M - (λw. spick w n x) -` C" using bernoulli bernoulli_stream_space by simp
        also have "...  sets (G n)" using (λw. spick w n x) -` C  sets (G n)
          by (metis algebra.compl_sets disc_filtr_def discrete_filtration sets.sigma_algebra_axioms
              sigma_algebra_def subalgebra_def)
        finally show "(λw. spick w n x) -` (space M - C)  sets (G n)" .
      }
      {
        fix C::"nat  bool stream set"
        assume "(i. C i  sigma_sets (space M) (i{m. m  Suc n}. {geom_proc i -` A  space M |A. A  sets borel}))"
          and "(i. (λw. spick w n x) -` C i  sets (G n))"
        hence "(λw. spick w n x) -` (C ` UNIV) = ( i UNIV. (λw. spick w n x) -` (C i))" by blast
        also have "...  sets (G n)" using i. (λw. spick w n x) -` C i  sets (G n) by simp
        finally show "(λw. spick w n x) -` (C ` UNIV)  sets (G n)" .
      }
    qed
    thus "(λw. spick w n x) -` B  space (G n)  sets (G n)" using stock_filtration stoch_proc_filt_space
      bernoulli bernoulli_stream_space by simp
  qed
qed

lemma (in CRR_market) delta_price_adapted:
   fixes cash_flow::"bool stream  real"
   assumes "cash_flow  borel_measurable (G T)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
  shows "borel_adapt_stoch_proc G (delta_price N cash_flow T)"
unfolding adapt_stoch_proc_def
proof
  fix n
  show "delta_price N cash_flow T n  borel_measurable (G n)"
  proof (cases "Suc n  T")
    case True
    hence deleq: "w. delta_price N cash_flow T n w = (rn_price N cash_flow T (Suc n) (spick w n True) - rn_price N cash_flow T (Suc n) (spick w n False))/
    ((geom_proc n w) * (u - d))" using delta_price_eq by simp
    have "(λw. rn_price N cash_flow T (Suc n) (spick w n True))  borel_measurable (G n)"
    proof -
      have "rn_price N cash_flow T (Suc n)  borel_measurable  (G (Suc n))" using rn_price_borel_adapt assms
        using True by blast
      moreover have "(λw. spick w n True)  G n M G (Suc n)" using spick_red_geom_filt by simp
      ultimately show ?thesis by simp
    qed
    moreover have "(λw. rn_price N cash_flow T (Suc n) (spick w n False))  borel_measurable (G n)"
    proof -
      have "rn_price N cash_flow T (Suc n)  borel_measurable  (G (Suc n))" using rn_price_borel_adapt assms
        using True by blast
      moreover have "(λw. spick w n False)  G n M G (Suc n)" using spick_red_geom_filt by simp
      ultimately show ?thesis by simp
    qed
    ultimately have "(λw. rn_price N cash_flow T (Suc n) (spick w n True) - rn_price N cash_flow T (Suc n) (spick w n False))
       borel_measurable (G n)" by simp
    moreover have "(λw. (geom_proc n w) * (u - d))  borel_measurable (G n)"
    proof -
      have "geom_proc n  borel_measurable (G n)" using stock_filtration
        by (metis adapt_stoch_proc_def stk_price stock_price_borel_measurable)
      thus ?thesis by simp
    qed
    ultimately have "(λw. (rn_price N cash_flow T (Suc n) (spick w n True) - rn_price N cash_flow T (Suc n) (spick w n False))/
      ((geom_proc n w) * (u - d))) borel_measurable (G n)" by simp
    thus ?thesis using deleq by presburger
  next
    case False
    thus ?thesis unfolding delta_price_def by simp
  qed
qed

fun (in CRR_market) delta_predict where
  "delta_predict N der matur 0  = (λw. delta_price N der matur 0 w)" |
  "delta_predict N der matur (Suc n) = (λw. delta_price N der matur n w)"

lemma (in CRR_market) delta_predict_predict:
  assumes "der  borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
  shows "borel_predict_stoch_proc G (delta_predict N der matur)" unfolding predict_stoch_proc_def
proof (intro conjI)
  show "delta_predict N der matur 0  borel_measurable (G 0)" using delta_price_adapted[of der matur N q]
    assms unfolding adapt_stoch_proc_def by force
  show "n. delta_predict N der matur (Suc n)  borel_measurable (G n)"
  proof
    fix n
    show "delta_predict N der matur (Suc n)  borel_measurable (G n)" using delta_price_adapted[of der matur N q]
    assms unfolding adapt_stoch_proc_def by force
  qed
qed


definition (in CRR_market) delta_pf where
"delta_pf N der matur = qty_single stk (delta_predict N der matur)"

lemma (in CRR_market) delta_pf_support:
  shows "support_set (delta_pf N der matur)  {stk}" unfolding delta_pf_def
  using single_comp_support[of stk "delta_predict N der matur"] by simp

definition (in CRR_market) self_fin_delta_pf where
"self_fin_delta_pf N der matur v0 = self_finance Mkt v0 (delta_pf N der matur) risk_free_asset"

lemma (in disc_equity_market) self_finance_trading_strat:
  assumes "trading_strategy pf"
and "portfolio pf"
and "borel_adapt_stoch_proc F (prices Mkt asset)"
and "support_adapt Mkt pf"
shows "trading_strategy (self_finance Mkt v pf asset)" unfolding self_finance_def
proof (rule sum_trading_strat)
  show "trading_strategy pf" using assms by simp
  show "trading_strategy (qty_single asset (remaining_qty Mkt v pf asset))" unfolding trading_strategy_def
  proof (intro conjI ballI)
  show "portfolio (qty_single asset (remaining_qty Mkt v pf asset))"
    by (simp add: self_finance_def single_comp_portfolio)
  show "a.
       a  support_set (qty_single asset (remaining_qty Mkt v pf asset)) 
       borel_predict_stoch_proc F (qty_single asset (remaining_qty Mkt v pf asset) a)"
  proof (cases "support_set (qty_single asset (remaining_qty Mkt v pf asset)) = {}")
    case False
    hence eqasset: "support_set (qty_single asset (remaining_qty Mkt v pf asset)) = {asset}"
      using single_comp_support by fastforce
    fix a
    assume "a support_set (qty_single asset (remaining_qty Mkt v pf asset))"
    hence "a = asset" using eqasset by simp
    hence "qty_single asset (remaining_qty Mkt v pf asset) a = (remaining_qty Mkt v pf asset)"
      unfolding qty_single_def by simp
    moreover have "borel_predict_stoch_proc F (remaining_qty Mkt v pf asset)"
    proof (rule remaining_qty_predict)
      show "trading_strategy pf" using assms by simp
      show "borel_adapt_stoch_proc F (prices Mkt asset)" using assms by simp
      show "support_adapt Mkt pf" using assms by simp
    qed
    ultimately show "borel_predict_stoch_proc F (qty_single asset (remaining_qty Mkt v pf asset) a)"
      by simp
  next
    case True
    thus "a. a  support_set (qty_single asset (remaining_qty Mkt v pf asset)) 
         support_set (qty_single asset (remaining_qty Mkt v pf asset)) = {} 
         borel_predict_stoch_proc F (qty_single asset (remaining_qty Mkt v pf asset) a)" by simp
  qed
qed
qed

lemma (in CRR_market) self_fin_delta_pf_trad_strat:
  assumes "der borel_measurable (G matur)"
and "N = bernoulli_stream q"
and "0 < q"
and "q < 1"
  shows "trading_strategy (self_fin_delta_pf N der matur v0)" unfolding self_fin_delta_pf_def
proof (rule self_finance_trading_strat)
  show "trading_strategy (delta_pf N der matur)" unfolding trading_strategy_def
  proof (intro conjI ballI)
    show "portfolio (delta_pf N der matur)" unfolding portfolio_def using delta_pf_support
      by (meson finite.emptyI finite_insert infinite_super)
    show "asset. asset  support_set (delta_pf N der matur)  borel_predict_stoch_proc G (delta_pf N der matur asset)"
    proof (cases "support_set (delta_pf N der matur) = {}")
      case False
      fix asset
      assume "asset  support_set (delta_pf N der matur)"
      hence "asset = stk" using False delta_pf_support by auto
      hence "delta_pf N der matur asset = delta_predict N der matur" unfolding delta_pf_def qty_single_def by simp
      thus "borel_predict_stoch_proc G (delta_pf N der matur asset)" using delta_predict_predict
        assms by simp
    next
      case True
      thus "asset. asset  support_set (delta_pf N der matur) 
             support_set (delta_pf N der matur) = {}  borel_predict_stoch_proc G (delta_pf N der matur asset)" by simp
    qed
  qed
  show "portfolio (delta_pf N der matur)" using delta_pf_support unfolding portfolio_def
    by (meson finite.emptyI finite_insert infinite_super)
  show "borel_adapt_stoch_proc G (prices Mkt risk_free_asset)" using rf_price
    disc_rfr_proc_borel_adapted by simp
  show "support_adapt Mkt (delta_pf N der matur)" unfolding support_adapt_def
  proof
    show "asset. asset  support_set (delta_pf N der matur)  borel_adapt_stoch_proc G (prices Mkt asset)"
    proof (cases "support_set (delta_pf N der matur) = {}")
      case False
      fix asset
      assume "asset  support_set (delta_pf N der matur)"
      hence "asset = stk" using False delta_pf_support by auto
      hence "prices Mkt asset = geom_proc" using stk_price by simp
      thus "borel_adapt_stoch_proc G (prices Mkt asset)"
        using asset = stk stock_price_borel_measurable by auto
    next
      case True
      thus "asset. asset  support_set (delta_pf N der matur)  borel_adapt_stoch_proc G (prices Mkt asset)"
        by simp
    qed
  qed
qed

definition (in CRR_market) delta_hedging where
"delta_hedging N der matur = self_fin_delta_pf N der matur
  (prob_space.expectation N (discounted_value r (λm. der) matur))"


lemma (in CRR_market)  geom_proc_eq_snth:
  shows "(m. m  Suc n  geom_proc m x = geom_proc m y) 
    (m. m  n  snth x m = snth y m)"
proof (induct n )
  case 0
  assume asm: "(m. m Suc  0  geom_proc m x = geom_proc m y)" and "m 0"
  hence "m = 0" by simp
  have "geom_proc (Suc 0) x = geom_proc (Suc 0) y" using asm by simp
  have "snth x 0 = snth y 0"
  proof (rule ccontr)
    assume "snth x 0  snth y 0"
    show False
    proof (cases "snth x 0")
      case True
      hence "¬ snth y 0" using ‹snth x 0  snth y 0 by simp
      have "geom_proc (Suc 0) x = u * init" using geometric_process True by simp
      moreover have "geom_proc (Suc 0) y = d * init" using geometric_process ¬ snth y 0 by simp
      ultimately have "geom_proc (Suc 0) x  geom_proc (Suc 0) y" using S0_positive down_lt_up by simp
      thus ?thesis using geom_proc (Suc 0) x = geom_proc (Suc 0) y by simp
    next
      case False
      hence "snth y 0" using ‹snth x 0  snth y 0 by simp
      have "geom_proc (Suc 0) x = d * init" using geometric_process False by simp
      moreover have "geom_proc (Suc 0) y = u * init" using geometric_process ‹snth y 0 by simp
      ultimately have "geom_proc (Suc 0) x  geom_proc (Suc 0) y" using S0_positive down_lt_up by simp
      thus ?thesis using geom_proc (Suc 0) x = geom_proc (Suc 0) y by simp
    qed
  qed
  thus "m. (m. m  Suc 0  geom_proc m x = geom_proc m y)  m  0  x !! m = y !! m" by simp
next
  case (Suc n)
  assume fst: "(m. (m. m  Suc n  geom_proc m x = geom_proc m y)  m  n  x !! m = y !! m)"
    and scd: "(m. m  Suc (Suc n)  geom_proc m x = geom_proc m y)" and "m  Suc n"
  show "x !! m = y !! m"
  proof (cases "m  n")
    case True
    thus ?thesis using fst scd by simp
  next
    case False
    hence "m = Suc n" using m Suc n by simp
    have "geom_proc (Suc (Suc n)) x = geom_proc (Suc (Suc n)) y" using scd by simp
    show ?thesis
    proof (rule ccontr)
      assume "x !! m  y !! m"
      thus False
      proof (cases "x !! m")
        case True
        hence "¬ y !! m" using x !! m  y !! m by simp
        have "geom_proc (Suc (Suc n)) x = u * geom_proc (Suc n) x" using geometric_process True
          m = Suc n by simp
        also have "... = u * geom_proc (Suc n) y" using scd m = Suc n by simp
        finally have "geom_proc (Suc (Suc n)) x = u * geom_proc (Suc n) y" .
        moreover have "geom_proc (Suc (Suc n)) y = d * geom_proc (Suc n) y" using geometric_process
          m = Suc n ¬ y !! m by simp
        ultimately have "geom_proc (Suc (Suc n)) x  geom_proc (Suc (Suc n)) y"
          by (metis S0_positive down_lt_up down_positive geom_rand_walk_strictly_positive less_irrefl mult_cancel_right)
        thus ?thesis using geom_proc (Suc (Suc n)) x = geom_proc (Suc (Suc n)) y by simp
      next
        case False
        hence "y !! m" using x !! m  y !! m by simp
        have "geom_proc (Suc (Suc n)) x = d * geom_proc (Suc n) x" using geometric_process False
          m = Suc n by simp
        also have "... = d * geom_proc (Suc n) y" using scd m = Suc n by simp
        finally have "geom_proc (Suc (Suc n)) x = d * geom_proc (Suc n) y" .
        moreover have "geom_proc (Suc (Suc n)) y = u * geom_proc (Suc n) y" using geometric_process
          m = Suc n y !! m by simp
        ultimately have "geom_proc (Suc (Suc n)) x  geom_proc (Suc (Suc n)) y"
          by (metis S0_positive down_lt_up down_positive geom_rand_walk_strictly_positive less_irrefl mult_cancel_right)
        thus ?thesis using geom_proc (Suc (Suc n)) x = geom_proc (Suc (Suc n)) y by simp
      qed
    qed
  qed
qed

lemma (in CRR_market)  geom_proc_eq_pseudo_proj_True:
  shows "(m. m   n  geom_proc m x = geom_proc m y) 
    (pseudo_proj_True (n) x = pseudo_proj_True (n) y)"
proof -
  assume a1: "m. m  n  geom_proc m x = geom_proc m y"
  obtain nn :: "bool stream  bool stream  nat  nat" where
    "x1 x2 x3. (v4<Suc (Suc x3). geom_proc v4 x2  geom_proc v4 x1) = (nn x1 x2 x3 < Suc (Suc x3)  geom_proc (nn x1 x2 x3) x2  geom_proc (nn x1 x2 x3) x1)"
    by moura
  then have f2: "n s sa na. (nn sa s n < Suc (Suc n)  geom_proc (nn sa s n) s  geom_proc (nn sa s n) sa  ¬ na < Suc n)  s !! na = sa !! na"
    by (meson geom_proc_eq_snth less_Suc_eq_le)
  obtain nna :: "bool stream  bool stream  nat  nat" where
    f3: "x0 x1 x2. (v3. Suc v3 < Suc x2  x1 !! v3  x0 !! v3) = (Suc (nna x0 x1 x2) < Suc x2  x1 !! nna x0 x1 x2  x0 !! nna x0 x1 x2)"
    by moura
  obtain nnb :: "nat  nat" where
    f4: "x0. (v2. x0 = Suc v2) = (x0 = Suc (nnb x0))"
    by moura
  moreover
  { assume "¬ nn y x (nnb n) < Suc (Suc (nnb n))  geom_proc (nn y x (nnb n)) x = geom_proc (nn y x (nnb n)) y"
    moreover
    { assume "¬ nna y x n < Suc (nnb n)"
      then have "¬ Suc (nna y x n) < Suc n  x !! nna y x n = y !! nna y x n"
        using f4 by (metis (no_types) Suc_le_D Suc_le_lessD less_Suc_eq_le) }
    ultimately have "pseudo_proj_True n x = pseudo_proj_True n y  ¬ Suc (nna y x n) < Suc n  x !! nna y x n = y !! nna y x n"
using f2 by meson }
  ultimately have "pseudo_proj_True n x = pseudo_proj_True n y  ¬ Suc (nna y x n) < Suc n  x !! nna y x n = y !! nna y x n"
    using a1 Suc_le_D less_Suc_eq_le by presburger
  then show ?thesis
    using f3 by (meson less_Suc_eq_le pseudo_proj_True_snth')
qed




lemma (in CRR_market)  proj_stoch_eq_pseudo_proj_True:
  assumes "proj_stoch_proc geom_proc m x = proj_stoch_proc geom_proc m y"
  shows "pseudo_proj_True m x = pseudo_proj_True m y"
proof -
  have " k  m. geom_proc k x = geom_proc k y"
  proof (intro allI impI)
    fix k
    assume "k  m"
    thus "geom_proc k x = geom_proc k y" using proj_stoch_proc_eq_snth[of geom_proc m x y k] assms by simp
  qed
  thus ?thesis  using geom_proc_eq_pseudo_proj_True[of m x y] by auto
qed

lemma (in CRR_market_viable) rn_rev_price_cond_expect:
  assumes "N = bernoulli_stream q"
and "0 <q"
and "q < 1"
and "der  borel_measurable (G matur)"
and "Suc n  matur"
shows "expl_cond_expect N (proj_stoch_proc geom_proc n) (rn_rev_price N der matur (matur - Suc n)) w=
  (q * rn_rev_price N der matur (matur - Suc n) (pseudo_proj_True n w)  +
      (1 - q) * rn_rev_price N der matur (matur - Suc n) (pseudo_proj_False n w))"
proof (rule infinite_cts_filtration.f_borel_Suc_expl_cond_expect)
  show "infinite_cts_filtration q N nat_filtration" using  assms  pslt psgt
    bernoulli_nat_filtration by simp
  show "rn_rev_price N der matur (matur - Suc n)  borel_measurable (nat_filtration (Suc n))"
    using rn_rev_price_rev_borel_adapt[of der matur N q "Suc n"]   assms
      stock_filtration stoch_proc_subalg_nat_filt[of geom_proc] geom_rand_walk_borel_adapted
    by (metis add_diff_cancel_right' diff_le_self measurable_from_subalg
        ordered_cancel_comm_monoid_diff_class.add_diff_inverse rn_rev_price_rev_borel_adapt)
  show "proj_stoch_proc geom_proc n  nat_filtration n M stream_space borel"
    using proj_stoch_adapted_if_adapted[of M nat_filtration geom_proc borel n]
    pslt psgt bernoulli_nat_filtration[of M p] bernoulli geom_rand_walk_borel_adapted
    nat_discrete_filtration by blast
  show "set_discriminating n (proj_stoch_proc geom_proc n) (stream_space borel)"
    using infinite_cts_filtration.proj_stoch_set_discriminating
    pslt psgt bernoulli_nat_filtration[of M p] bernoulli geom_rand_walk_borel_adapted by simp
  show "proj_stoch_proc geom_proc n -` {proj_stoch_proc geom_proc n w}  sets (nat_filtration n)"
    using infinite_cts_filtration.proj_stoch_singleton_set
    pslt psgt bernoulli_nat_filtration[of M p] bernoulli geom_rand_walk_borel_adapted by simp
  show "y z. proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z  y !! n = z !! n 
    rn_rev_price N der matur (matur - Suc n) y = rn_rev_price N der matur (matur - Suc n) z"
  proof (intro allI impI)
    fix y z
    assume as:"proj_stoch_proc geom_proc n y = proj_stoch_proc geom_proc n z  y !! n = z !! n"
    hence "pseudo_proj_True n y = pseudo_proj_True n z" using proj_stoch_eq_pseudo_proj_True[of n y z] by simp
    moreover have "snth y n = snth z n" using as by simp
    ultimately have "pseudo_proj_True (Suc n) y = pseudo_proj_True (Suc n) z"
    proof -
    have f1: "n s sa. (na. Suc na  n  s !! na  sa !! na)  pseudo_proj_True n s = pseudo_proj_True n sa"
    by (meson pseudo_proj_True_snth')
      obtain nn :: "bool stream  bool stream  nat  nat" where
        "x0 x1 x2. (v3. Suc v3  x2  x1 !! v3  x0 !! v3) = (Suc (nn x0 x1 x2)  x2  x1 !! nn x0 x1 x2  x0 !! nn x0 x1 x2)"
        by moura
        then have f2: "n s sa. Suc (nn sa s n)  n  s !! nn sa s n  sa !! nn sa s n  pseudo_proj_True n s = pseudo_proj_True n sa"
          using f1 by presburger
        have f3: "stake n y = stake n (pseudo_proj_True n z)"
          by (metis ‹pseudo_proj_True n y = pseudo_proj_True n z pseudo_proj_True_stake)
        { assume "stake (Suc n) z  stake (Suc n) (pseudo_proj_True (Suc n) y)"
          then have "stake n y @ [y !! n]  stake n z @ [z !! n]"
            by (metis (no_types) pseudo_proj_True_stake stake_Suc)
          then have "stake (Suc n) z = stake (Suc n) (pseudo_proj_True (Suc n) y)"
            using f3 by (simp add: y !! n = z !! n pseudo_proj_True_stake) }
        then have "¬ Suc (nn z y (Suc n))  Suc n  y !! nn z y (Suc n) = z !! nn z y (Suc n)"
        by (metis (no_types) pseudo_proj_True_stake stake_snth)
      then show ?thesis
        using f2 by blast
    qed
    have "rn_rev_price N der matur (matur - Suc n) y =
      rn_rev_price N der matur (matur - Suc n) (pseudo_proj_True (Suc n) y)" using nat_filtration_info[of "rn_rev_price N der matur (matur - Suc n)" "Suc n"]
      rn_rev_price_rev_borel_adapt[of der matur N q]
      by (metis ‹rn_rev_price N der matur (matur - Suc n)  borel_measurable (nat_filtration (Suc n)) o_apply)
    also have "... = rn_rev_price N der matur (matur - Suc n) (pseudo_proj_True (Suc n) z)"
      using ‹pseudo_proj_True (Suc n) y = pseudo_proj_True (Suc n) z by simp
    also have "... = rn_rev_price N der matur (matur - Suc n) z" using nat_filtration_info[of "rn_rev_price N der matur (matur - Suc n)" "Suc n"]
      rn_rev_price_rev_borel_adapt[of der matur N q]
      by (metis ‹rn_rev_price N der matur (matur - Suc n)  borel_measurable (nat_filtration (Suc n)) o_apply)
    finally show "rn_rev_price N der matur (matur - Suc n) y = rn_rev_price N der matur (matur - Suc n) z" .
  qed
  show "0 < q" and "q < 1" using assms by auto
qed




lemma (in CRR_market_viable) rn_price_eq_ind:
  assumes "N = bernoulli_stream q"
and "n < matur"
and "0 < q"
and "q < 1"
and "der  borel_measurable (G matur)"
shows "(1+r) * rn_price N der matur n w = q * rn_price N der matur (Suc n) (pseudo_proj_True n w) +
  (1 - q) * rn_price N der matur (Suc n) (pseudo_proj_False n w)"
proof -
  define V where "V = rn_price N der matur"
  let ?m = "matur - Suc n"
  have "matur -n = Suc ?m" by (simp add: assms Suc_diff_Suc Suc_le_lessD)
  have "(1+r) * V n w = (1+r) * rn_price_ind N der matur n w" using rn_price_eq assms unfolding V_def by simp
  also have "... = (1+r) * rn_rev_price N der matur (Suc ?m) w" using matur -n = Suc ?m
    unfolding rn_price_ind_def by simp
  also have "... = (1+r) * discount_factor r (Suc 0) w *
                    expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc ?m)) (rn_rev_price N der matur ?m) w"
    by simp
  also have "... = expl_cond_expect N (proj_stoch_proc geom_proc (matur - Suc ?m)) (rn_rev_price N der matur ?m) w"
    unfolding discount_factor_def using acceptable_rate by auto
  also have "... = expl_cond_expect N (proj_stoch_proc geom_proc n) (rn_rev_price N der matur ?m) w"
    using matur -n = Suc ?m by simp
  also have "... = (q * rn_rev_price N der matur ?m (pseudo_proj_True n w)  +
    (1 - q) * rn_rev_price N der matur ?m (pseudo_proj_False n w))"
    using rn_rev_price_cond_expect[of N q der matur n w] assms   by simp
  also have "... =  q * rn_price_ind N der matur (Suc n) (pseudo_proj_True n w) +
    (1 - q) * rn_price_ind N der matur (Suc n) (pseudo_proj_False n w)" unfolding rn_price_ind_def by simp
  also have "... = q * rn_price N der matur (Suc n) (pseudo_proj_True n w) +
    (1 - q) * rn_price N der matur (Suc n) (pseudo_proj_False n w)" using rn_price_eq assms  by simp
  also have "... = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) *V (Suc n) (pseudo_proj_False n w)"
    unfolding V_def by simp
  finally have "(1+r) * V n w = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) *V (Suc n) (pseudo_proj_False n w)" .
  thus ?thesis unfolding V_def by simp
qed



lemma self_finance_updated_suc_suc:
  assumes "portfolio pf"
  and "n. prices Mkt asset n w  0"
  shows "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc (Suc n)) w = cls_val_process Mkt pf (Suc (Suc n)) w +
    (prices Mkt asset (Suc (Suc n)) w / (prices Mkt asset (Suc n) w)) *
      (cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w -
     val_process Mkt pf (Suc n) w)"
proof -
  have "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc (Suc n)) w = cls_val_process Mkt pf (Suc (Suc n)) w +
    prices Mkt asset (Suc (Suc n)) w * remaining_qty Mkt v pf asset (Suc (Suc n)) w" using assms
    by (simp add: self_finance_updated)
  also have "... = cls_val_process Mkt pf (Suc (Suc n)) w +
    prices Mkt asset (Suc (Suc n)) w * ((remaining_qty Mkt v pf asset (Suc n) w) +
    (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w))"
    by simp
  also have "... = cls_val_process Mkt pf (Suc (Suc n)) w +
    prices Mkt asset (Suc (Suc n)) w *
      ((prices Mkt asset (Suc n) w) * (remaining_qty Mkt v pf asset (Suc n) w) / (prices Mkt asset (Suc n) w) +
    (cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w))" using assms
    by (metis nonzero_mult_div_cancel_left)
  also have "... = cls_val_process Mkt pf (Suc (Suc n)) w +
    prices Mkt asset (Suc (Suc n)) w * ((prices Mkt asset (Suc n) w) * (remaining_qty Mkt v pf asset (Suc n) w) +
    cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)/(prices Mkt asset (Suc n) w)"
    using add_divide_distrib[symmetric, of "prices Mkt asset (Suc n) w * remaining_qty Mkt v pf asset (Suc n) w"
        "prices Mkt asset (Suc n) w"]  by simp
  also have "... = cls_val_process Mkt pf (Suc (Suc n)) w +
    (prices Mkt asset (Suc (Suc n)) w / (prices Mkt asset (Suc n) w)) *
    ((prices Mkt asset (Suc n) w) * (remaining_qty Mkt v pf asset (Suc n) w) +
    cls_val_process Mkt pf (Suc n) w - val_process Mkt pf (Suc n) w)" by simp
  also have "... = cls_val_process Mkt pf (Suc (Suc n)) w +
    (prices Mkt asset (Suc (Suc n)) w / (prices Mkt asset (Suc n) w)) *
      (cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w -
     val_process Mkt pf (Suc n) w)"
    using self_finance_updated[of Mkt asset n w pf v] assms by auto
  finally show ?thesis .
qed

lemma self_finance_updated_suc_0:
  assumes "portfolio pf"
  and "n w. prices Mkt asset n w  0"
  shows "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc 0) w = cls_val_process Mkt pf (Suc 0) w +
    (prices Mkt asset (Suc 0) w / (prices Mkt asset 0 w)) *
      (val_process Mkt (self_finance Mkt v pf asset) 0 w -
     val_process Mkt pf 0 w)"
proof -
  have "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc 0) w = cls_val_process Mkt pf (Suc 0) w +
    prices Mkt asset (Suc 0) w * remaining_qty Mkt v pf asset (Suc 0) w" using assms
    by (simp add: self_finance_updated)
  also have "... = cls_val_process Mkt pf (Suc 0) w +
    prices Mkt asset (Suc 0) w * ((v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))"
    by simp
  also have "... = cls_val_process Mkt pf (Suc 0) w +
    prices Mkt asset (Suc 0) w * ((remaining_qty Mkt v pf asset 0 w) +
    (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))"
    by simp
  also have "... = cls_val_process Mkt pf (Suc 0) w +
    prices Mkt asset (Suc 0) w *
      ((prices Mkt asset 0 w) * (remaining_qty Mkt v pf asset 0 w) / (prices Mkt asset 0 w) +
    (v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w))" using assms
    by (metis nonzero_mult_div_cancel_left)
  also have "... = cls_val_process Mkt pf (Suc 0) w +
    prices Mkt asset (Suc 0) w * ((prices Mkt asset 0 w) * (remaining_qty Mkt v pf asset 0 w) +
    v - val_process Mkt pf 0 w)/(prices Mkt asset 0 w)"
    using add_divide_distrib[symmetric, of "prices Mkt asset 0 w * remaining_qty Mkt v pf asset 0 w"
        "prices Mkt asset 0 w"]  by simp
  also have "... = cls_val_process Mkt pf (Suc 0) w +
    (prices Mkt asset (Suc 0) w / (prices Mkt asset 0 w)) *
    ((prices Mkt asset 0 w) * (remaining_qty Mkt v pf asset 0 w) +
    v - val_process Mkt pf 0 w)" by simp
  also have "... = cls_val_process Mkt pf (Suc 0) w +
    (prices Mkt asset (Suc 0) w / (prices Mkt asset 0 w)) *
    ((prices Mkt asset 0 w) * (remaining_qty Mkt v pf asset 0 w) +
    val_process Mkt (self_finance Mkt v pf asset) 0 w - val_process Mkt pf 0 w)"
    using self_finance_init[of Mkt asset pf v w] assms by simp
  also have "... = cls_val_process Mkt pf (Suc 0) w +
    (prices Mkt asset (Suc 0) w / (prices Mkt asset 0 w)) *
      (val_process Mkt (self_finance Mkt v pf asset) 0 w -
     val_process Mkt pf 0 w)" by simp
  finally show ?thesis .
qed

lemma self_finance_updated_ind:
  assumes "portfolio pf"
  and "n w. prices Mkt asset n w  0"
  shows "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w = cls_val_process Mkt pf (Suc n) w +
    (prices Mkt asset (Suc n) w / (prices Mkt asset n w)) *
      (val_process Mkt (self_finance Mkt v pf asset) n w -
     val_process Mkt pf n w)"
proof (cases "n = 0")
  case True
  thus ?thesis using assms self_finance_updated_suc_0 by simp
next
  case False
  hence "m. n = Suc m" by (simp add: not0_implies_Suc)
  from this obtain m where "n = Suc m" by auto
  hence "cls_val_process Mkt (self_finance Mkt v pf asset) (Suc n) w =
    cls_val_process Mkt (self_finance Mkt v pf asset) (Suc (Suc m)) w" by simp
  also have "...  = cls_val_process Mkt pf (Suc (Suc m)) w +
    (prices Mkt asset (Suc (Suc m)) w / (prices Mkt asset (Suc m) w)) *
      (cls_val_process Mkt (self_finance Mkt v pf asset) (Suc m) w -
     val_process Mkt pf (Suc m) w)" using assms self_finance_updated_suc_suc[of pf] by simp
  also have "... = cls_val_process Mkt pf (Suc (Suc m)) w +
    (prices Mkt asset (Suc (Suc m)) w / (prices Mkt asset (Suc m) w)) *
      (val_process Mkt (self_finance Mkt v pf asset) (Suc m) w -
     val_process Mkt pf (Suc m) w)" using assms self_finance_charact unfolding self_financing_def
    by (simp add: self_finance_succ self_finance_updated)
  also have "... = cls_val_process Mkt pf (Suc n) w +
    (prices Mkt asset (Suc n) w / (prices Mkt asset n w)) *
      (val_process Mkt (self_finance Mkt v pf asset) n w -
     val_process Mkt pf n w)" using n = Suc m by simp
  finally show ?thesis .
qed


lemma  (in rfr_disc_equity_market) self_finance_risk_free_update_ind:
  assumes "portfolio pf"
  shows "cls_val_process Mkt (self_finance Mkt v pf risk_free_asset) (Suc n) w = cls_val_process Mkt pf (Suc n) w +
    (1 + r) * (val_process Mkt (self_finance Mkt v pf risk_free_asset) n w - val_process Mkt pf n w)"
proof -
  have "cls_val_process Mkt (self_finance Mkt v pf risk_free_asset) (Suc n) w =
    cls_val_process Mkt pf (Suc n) w +
    (prices Mkt risk_free_asset (Suc n) w / (prices Mkt risk_free_asset n w)) *
      (val_process Mkt (self_finance Mkt v pf risk_free_asset) n w -
     val_process Mkt pf n w)"
  proof (rule self_finance_updated_ind, (simp add: assms), intro allI)
    fix n w
    show "prices Mkt risk_free_asset n w  0" using positive by (metis less_irrefl)
  qed
  also have "... = cls_val_process Mkt pf (Suc n) w +
    (1+r) * (val_process Mkt (self_finance Mkt v pf risk_free_asset) n w -
     val_process Mkt pf n w)" using rf_price  positive
    by (metis acceptable_rate disc_rfr_proc_Suc_div)
  finally show ?thesis .
qed



lemma (in CRR_market) delta_pf_portfolio:
  shows "portfolio (delta_pf N der matur)" unfolding delta_pf_def by (simp add: single_comp_portfolio)

lemma (in CRR_market) delta_pf_updated:
  shows "cls_val_process Mkt (delta_pf N der matur) (Suc n) w =
    geom_proc (Suc n) w * delta_price N der matur n w" unfolding delta_pf_def
    using stk_price qty_single_updated[of Mkt] by simp

lemma (in CRR_market) delta_pf_val_process:
  shows "val_process Mkt (delta_pf N der matur) n w =
    geom_proc n w * delta_price N der matur n w" unfolding delta_pf_def
  using stk_price qty_single_val_process[of Mkt] by simp

lemma (in CRR_market) delta_hedging_cls_val_process:
  shows "cls_val_process Mkt (delta_hedging N der matur) (Suc n) w =
    geom_proc (Suc n) w * delta_price N der matur n w +
    (1 + r) * (val_process Mkt (delta_hedging N der matur) n w - geom_proc n w * delta_price N der matur n w)"
proof -
  define X where "X = delta_hedging N der matur"
  define init where "init = integralL N (discounted_value r (λm. der) matur)"
  have "cls_val_process Mkt X (Suc n) w = cls_val_process Mkt (delta_pf N der matur) (Suc n) w +
    (1 + r) * (val_process Mkt X n w - val_process Mkt (delta_pf N der matur) n w)"
    unfolding X_def delta_hedging_def self_fin_delta_pf_def init_def
  proof (rule self_finance_risk_free_update_ind)
    show "portfolio (delta_pf N der matur)" unfolding  portfolio_def using delta_pf_support
      by (meson finite.simps infinite_super)
  qed
  also have "... = geom_proc (Suc n) w * delta_price N der matur n w +
    (1 + r) * (val_process Mkt X n w - val_process Mkt (delta_pf N der matur) n w)"
    using delta_pf_updated by simp
  also have "... = geom_proc (Suc n) w * delta_price N der matur n w +
    (1 + r) * (val_process Mkt X n w - geom_proc n w * delta_price N der matur n w)"
    using delta_pf_val_process by simp
  finally show ?thesis unfolding X_def .
qed







lemma (in CRR_market_viable) delta_hedging_eq_derivative_price:
  fixes der::"bool stream  real" and matur::nat
  assumes "N = bernoulli_stream ((1 + r - d) / (u - d))"
  and "der borel_measurable (G matur)"
  shows "n w. n matur 
    val_process Mkt (delta_hedging N der matur) n w =
    (rn_price N der matur) n w"
unfolding delta_hedging_def
proof -
  define q where "q = (1 + r - d) / (u - d)"
  have "0 < q" and "q < 1" unfolding q_def using assms gt_param lt_param CRR_viable by auto
  note qprops = this
  define init where  "init = (prob_space.expectation N (discounted_value r (λm. der) matur))"
  define X where "X = val_process Mkt (delta_hedging N der matur)"
  define V where "V = rn_price N der matur"
  define Δ where "Δ = delta_price N der matur"
  {
    fix n
    fix w
    have "n  matur  X n w = V n w"
    proof (induct n)
    case 0
    have v0: "V 0  borel_measurable (G 0)" using assms rn_price_borel_adapt "0.prems" qprops
      unfolding V_def q_def by auto
    have "X 0 w= init" using self_finance_init[of Mkt risk_free_asset "delta_pf N der matur" "integralL N (discounted_value r (λm. der) matur)"]
        delta_pf_support
      unfolding  X_def init_def delta_hedging_def self_fin_delta_pf_def init_def
      by (metis finite_insert infinite_imp_nonempty infinite_super less_irrefl portfolio_def positive)
    also have "... = V 0 w" 
    proof -
      have "xspace N. real_cond_exp N (G 0) (discounted_value r (λm. der) matur) x =
        integralL N (discounted_value r (λm. der) matur)"
      proof (rule prob_space.trivial_subalg_cond_expect_eq)
        show "prob_space N" using assms qprops unfolding q_def
          by (simp add: bernoulli bernoulli_stream_def prob_space.prob_space_stream_space prob_space_measure_pmf)
        have "init_triv_filt M (stoch_proc_filt M geom_proc borel)"
        proof (rule infinite_cts_filtration.stoch_proc_filt_triv_init)
          show "borel_adapt_stoch_proc nat_filtration geom_proc" using geom_rand_walk_borel_adapted by simp
          show "infinite_cts_filtration p M nat_filtration" using bernoulli_nat_filtration[of M p] bernoulli psgt pslt
            by simp
        qed
        hence "init_triv_filt N (stoch_proc_filt M geom_proc borel)" using assms qprops
          filt_equiv_triv_init[of nat_filtration N] stock_filtration
          bernoulli_stream_equiv[of N] psgt pslt unfolding q_def by simp
        thus "subalgebra N (G 0)" and "sets (G 0) = {{}, space N}" using stock_filtration unfolding init_triv_filt_def
          filtration_def bot_nat_def by auto
        show "integrable N (discounted_value r (λm. der) matur)"
        proof (rule bernoulli_discounted_integrable)
          show "der  borel_measurable (nat_filtration matur)" using assms geom_rand_walk_borel_adapted
              measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
          show "N = bernoulli_stream q" using assms unfolding q_def by simp
          show "0 < q" "q < 1" using qprops by auto
        qed (simp add: acceptable_rate)
      qed
      hence "integralL N (discounted_value r (λm. der) matur) =
        real_cond_exp N (G 0) (discounted_value r (λm. der) matur) w" using bernoulli_stream_space[of N q]
        by (simp add: assms(1) q_def)
      also have "... = real_cond_exp N (stoch_proc_filt M geom_proc borel 0) (discounted_value r (λm. der) matur) w"
        using stock_filtration by simp
      also have "... = real_cond_exp N (stoch_proc_filt N geom_proc borel 0) (discounted_value r (λm. der) matur) w"
        using stoch_proc_filt_filt_equiv[of nat_filtration M N geom_proc]
          bernoulli_stream_equiv[of N] q_def qprops assms pslt psgt by auto
      also have "... = expl_cond_expect N (proj_stoch_proc geom_proc 0) (discounted_value r (λm. der) matur) w"
      proof (rule bernoulli_cond_exp)
        show "N = bernoulli_stream q" using assms unfolding q_def by simp
        show "0 < q" "q < 1" using qprops by auto
        show "integrable N (discounted_value r (λm. der) matur)"
        proof (rule bernoulli_discounted_integrable)
          show "der  borel_measurable (nat_filtration matur)" using assms geom_rand_walk_borel_adapted
              measurable_from_subalg stoch_proc_subalg_nat_filt stock_filtration by blast
          show "N = bernoulli_stream q" using assms unfolding q_def by simp
          show "0 < q" "q < 1" using qprops by auto
        qed (simp add: acceptable_rate)
      qed
      finally show "init = V 0 w" unfolding init_def V_def rn_price_def by simp
    qed
    finally show "X 0 w = V 0 w" .
    next
      case (Suc n)
      hence "n < matur" by simp
      show ?case
      proof -
        have "X n w = V n w" using Suc by (simp add: Suc.hyps Suc.prems Suc_leD)
        have "0< 1+r" using acceptable_rate by simp
        let ?m = "matur - Suc n"
        have "matur -n = Suc ?m" by (simp add: Suc.prems Suc_diff_Suc Suc_le_lessD)
        have "(1+r) * V n w = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) *V (Suc n) (pseudo_proj_False n w)"
          using rn_price_eq_ind qprops assms Suc q_def V_def by simp
        show "X (Suc n) w = V (Suc n) w"
        proof (cases "snth w n")
        case True
          hence pseq: "pseudo_proj_True (Suc n) w = pseudo_proj_True (Suc n) (spick w n True)"
            by (metis (mono_tags, lifting) pseudo_proj_True_stake_image spickI stake_Suc)
          have "X (Suc n) w = cls_val_process Mkt (delta_hedging N der matur) (Suc n) w"
            unfolding X_def delta_hedging_def self_fin_delta_pf_def using  delta_pf_portfolio
            unfolding self_financing_def
            by (metis less_irrefl positive self_finance_charact self_financingE)
          also have "... = geom_proc (Suc n) w * Δ n w + (1 + r) * (X n w - geom_proc n w * Δ n w)"
            using delta_hedging_cls_val_process unfolding X_def Δ_def by simp
          also have "... = u * geom_proc n w * Δ n w + (1 + r) * (X n w - geom_proc n w * Δ n w)"
            using True geometric_process by simp
          also have "... = u * geom_proc n w * Δ n w + (1 + r) * X n w - (1+r) * geom_proc n w * Δ n w"
            by (simp add: right_diff_distrib)
          also have "... = (1+r) * X n w + geom_proc n w * Δ n w * u - geom_proc n w * Δ n w * (1 + r)"
            by (simp add: mult.commute mult.left_commute)
          also have "... = (1+r)* X n w + geom_proc n w * Δ n w * (u - (1 + r))" by (simp add: right_diff_distrib)
          also have "... = (1+r) * X n w + geom_proc n w * (V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))/
            (geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False)) * (u - (1 + r))"
            using Suc V_def by (simp add: Δ_def delta_price_def geom_rand_walk_diff_induct)
          also have "... = (1+r) * X n w + geom_proc n w * ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))) /
            (geom_proc n w * (u - d)) * (u - (1 + r))"
          proof -
            have "geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False) =
              geom_proc n w * (u - d)"
              by (simp add: geom_rand_walk_diff_induct)
            then show ?thesis by simp
          qed
          also have "... = (1+r) * X n w + ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w)))* (u - (1 + r))/ (u-d)"
          proof -
            have "geom_proc n w  0"
              by (metis S0_positive down_lt_up down_positive geom_rand_walk_strictly_positive less_irrefl)
            then show ?thesis
              by simp
          qed
          also have "... = (1+r) * X n w + ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))* (1 - q))"
          proof -
            have "1 - q = 1 - (1 + r - d)/(u -d)" unfolding q_def by simp
            also have "... = (u - d)/(u - d) - (1 + r - d)/(u -d)" using down_lt_up by simp
            also have "... = (u - d - (1 + r - d))/(u - d)" using diff_divide_distrib[of "u - d" "1 + r -d"] by simp
            also have "... = (u - (1+r))/(u-d)" by simp
            finally have "1 - q = (u - (1+r))/(u-d)" .
            thus ?thesis by simp
          qed
          also have "... = (1+r) * X n w + (1 - q) * V (Suc n) (pseudo_proj_True n w) -
            (1 - q) * V (Suc n) (pseudo_proj_False n w)"
            by (simp add: mult.commute right_diff_distrib)
          also have "... = (1+r) * V n w + (1 - q) * V (Suc n) (pseudo_proj_True n w) -
            (1 - q) * V (Suc n) (pseudo_proj_False n w)" using X n w = V n w by simp
          also have "... = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) * V (Suc n) (pseudo_proj_False n w) +
            (1 - q) * V (Suc n) (pseudo_proj_True n w) - (1 - q) * V (Suc n) (pseudo_proj_False n w)"
          using assms Suc rn_price_eq_ind[of N q n matur der w] n < matur qprops unfolding V_def q_def
            by simp
          also have "... = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) * V (Suc n) (pseudo_proj_True n w)" by simp
          also have "... = V (Suc n) (pseudo_proj_True n w)"
            using distrib_right[of q "1 - q"  "V (Suc n) (pseudo_proj_True n w)"] by simp
          also have "... = V (Suc n) w"
          proof -
            have "V (Suc n)  borel_measurable (G (Suc n))" unfolding V_def q_def
            proof (rule rn_price_borel_adapt)
              show "der  borel_measurable (G matur)" using assms by simp
              show "N = bernoulli_stream q" using assms unfolding q_def by simp
              show "0 < q" and "q < 1" using qprops by auto
              show "Suc n  matur" using Suc by simp
            qed
            hence "V (Suc n) (pseudo_proj_True n w) = V (Suc n) (pseudo_proj_True (Suc n) (pseudo_proj_True n w))"
              using  geom_proc_filt_info[of "V (Suc n)" "Suc n"] by simp
            also have "... = V (Suc n) (pseudo_proj_True (Suc n) w)" using True
              by (simp add: pseq spick_eq_pseudo_proj_True)
            also have "... = V (Suc n) w" using V (Suc n)  borel_measurable (G (Suc n))
              geom_proc_filt_info[of "V (Suc n)" "Suc n"] by simp
            finally show ?thesis .
          qed
          finally show "X (Suc n) w = V (Suc n) w" .
        next
        case False
          hence pseq: "pseudo_proj_True (Suc n) w = pseudo_proj_True (Suc n) (spick w n False)" using filtration
            by (metis (full_types) pseudo_proj_True_def spickI stake_Suc)
          have "X (Suc n) w = cls_val_process Mkt (delta_hedging N der matur) (Suc n) w"
            unfolding X_def delta_hedging_def self_fin_delta_pf_def using  delta_pf_portfolio
            unfolding self_financing_def
            by (metis less_irrefl positive self_finance_charact self_financingE)
          also have "... = geom_proc (Suc n) w * Δ n w + (1 + r) * (X n w - geom_proc n w * Δ n w)"
            using delta_hedging_cls_val_process unfolding X_def Δ_def by simp
          also have "... = d * geom_proc n w * Δ n w + (1 + r) * (X n w - geom_proc n w * Δ n w)"
            using False geometric_process by simp
          also have "... = d * geom_proc n w * Δ n w + (1 + r) * X n w - (1+r) * geom_proc n w * Δ n w"
            by (simp add: right_diff_distrib)
          also have "... = (1+r) * X n w + geom_proc n w * Δ n w * d - geom_proc n w * Δ n w * (1 + r)"
            by (simp add: mult.commute mult.left_commute)
          also have "... = (1+r)* X n w + geom_proc n w * Δ n w * (d - (1 + r))" by (simp add: right_diff_distrib)
          also have "... = (1+r) * X n w + geom_proc n w * (V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))/
            (geom_proc (Suc n) (spick w n True) - geom_proc (Suc n) (spick w n False)) * (d - (1 + r))"
            using Suc V_def by (simp add: Δ_def delta_price_def geom_rand_walk_diff_induct)
          also have "... = (1+r) * X n w + geom_proc n w * ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))) /
            (geom_proc n w * (u - d)) * (d - (1 + r))"
            by (simp add: geom_rand_walk_diff_induct)
          also have "... = (1+r) * X n w + ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w)))* (d - (1 + r))/ (u-d)"
          proof -
            have "geom_proc n w  0"
              by (metis S0_positive down_lt_up down_positive geom_rand_walk_strictly_positive less_irrefl)
            then show ?thesis
              by simp
          qed
          also have "... = (1+r) * X n w + ((V (Suc n) (pseudo_proj_True n w) - V (Suc n) (pseudo_proj_False n w))* (-q))"
          proof -
            have "0-q = 0-(1 + r - d)/(u -d)" unfolding q_def by simp
            also have "... = (d - (1 + r))/(u -d)" by (simp add: minus_divide_left)
            finally have "0 - q = (d - (1+r))/(u-d)" .
            thus ?thesis by simp
          qed
          also have "... = (1+r) * X n w + (- V (Suc n) (pseudo_proj_True n w) * q + V (Suc n) (pseudo_proj_False n w)* q)"
            by (metis (no_types, hide_lams) add.inverse_inverse distrib_right minus_mult_commute minus_real_def mult_minus_left)
          also have "... = (1+r) * X n w - q * V (Suc n) (pseudo_proj_True n w) + q * V (Suc n) (pseudo_proj_False n w)" by simp
          also have "... = (1+r) * V n w -q * V (Suc n) (pseudo_proj_True n w) +
            q * V (Suc n) (pseudo_proj_False n w)" using X n w = V n w by simp
          also have "... = q * V (Suc n) (pseudo_proj_True n w) + (1 - q) * V (Suc n) (pseudo_proj_False n w) -
            q * V (Suc n) (pseudo_proj_True n w) + q * V (Suc n) (pseudo_proj_False n w)"
            using assms Suc rn_price_eq_ind[of N q n matur der w] n < matur qprops unfolding V_def q_def
            by simp
          also have "... = (1-q) * V (Suc n) (pseudo_proj_False n w) + q * V (Suc n) (pseudo_proj_False n w)" by simp
          also have "... = V (Suc n) (pseudo_proj_False n w)"
            using distrib_right[of q "1 - q"  "V (Suc n) (pseudo_proj_False n w)"] by simp
          also have "... = V (Suc n) w"
          proof -
            have "V (Suc n)  borel_measurable (G (Suc n))" unfolding V_def q_def
            proof (rule rn_price_borel_adapt)
              show "der  borel_measurable (G matur)" using assms by simp
              show "N = bernoulli_stream q" using assms unfolding q_def by simp
              show "0 < q" and "q < 1" using qprops by auto
              show "Suc n  matur" using Suc by simp
            qed
            hence "V (Suc n) (pseudo_proj_False n w) = V (Suc n) (pseudo_proj_False (Suc n) (pseudo_proj_False n w))"
              using  geom_proc_filt_info'[of "V (Suc n)" "Suc n"] by simp
            also have "... = V (Suc n) (pseudo_proj_False (Suc n) w)" using False  spick_eq_pseudo_proj_False
              by (metis pseq pseudo_proj_True_imp_False)
            also have "... = V (Suc n) w" using V (Suc n)  borel_measurable (G (Suc n))
              geom_proc_filt_info'[of "V (Suc n)" "Suc n"] by simp
            finally show ?thesis .
          qed
          finally show "X (Suc n) w = V (Suc n) w" .
        qed
      qed
    qed
  }
  thus "n w. n  matur 
           val_process Mkt (self_fin_delta_pf N der matur (integralL N (discounted_value r (λm. der) matur))) n w =
            rn_price N der matur n w" by (simp add: X_def init_def V_def delta_hedging_def)
qed


lemma (in CRR_market_viable) delta_hedging_same_cash_flow:
  assumes "der  borel_measurable (G matur)"
and "N = bernoulli_stream ((1 + r - d) / (u - d))"
  shows "cls_val_process Mkt (delta_hedging N der matur) matur w =
    der w"
proof  -
  define q where "q = (1 + r - d) / (u - d)"
  have "0 < q" and "q < 1" unfolding q_def using assms gt_param lt_param CRR_viable by auto
  note qprops = this
  have "cls_val_process Mkt (delta_hedging N der matur) matur w =
    val_process Mkt (delta_hedging N der matur) matur w" using self_financingE self_finance_charact
    unfolding delta_hedging_def self_fin_delta_pf_def
    by (metis delta_pf_portfolio mult_1s(1) mult_cancel_right not_real_square_gt_zero positive)
  also have "... = rn_price N der matur matur w" using delta_hedging_eq_derivative_price assms by simp
  also have "... = rn_rev_price N der matur 0 w" using rn_price_eq qprops assms
    unfolding rn_price_ind_def q_def by simp
  also have "... = der w" by simp
  finally show ?thesis .
qed

lemma (in CRR_market) delta_hedging_trading_strat:
  assumes "N = bernoulli_stream q"
  and "0 < q"
and "q < 1"
and "der  borel_measurable (G matur)"
  shows "trading_strategy (delta_hedging N der matur)" unfolding delta_hedging_def
  by (simp add: assms self_fin_delta_pf_trad_strat)

lemma (in CRR_market) delta_hedging_self_financing:
  shows "self_financing Mkt (delta_hedging N der matur)" unfolding delta_hedging_def self_fin_delta_pf_def
proof (rule self_finance_charact)
  show "n w. prices Mkt risk_free_asset (Suc n) w  0" using positive
    by (metis less_numeral_extra(3))
  show "portfolio (delta_pf N der matur)" using delta_pf_portfolio .
qed

lemma (in CRR_market_viable) delta_hedging_replicating:
  assumes "der  borel_measurable (G matur)"
  and "N = bernoulli_stream ((1 + r - d) / (u - d))"
  shows "replicating_portfolio (delta_hedging N der matur) der matur"
unfolding replicating_portfolio_def
proof (intro conjI)
  define q where "q = (1 + r - d) / (u - d)"
  have "0 < q" and "q < 1" unfolding q_def using assms gt_param lt_param CRR_viable by auto
  note qprops = this
  let ?X = "(delta_hedging N der matur)"
  show "trading_strategy ?X" using delta_hedging_trading_strat qprops assms unfolding q_def by simp
  show "self_financing Mkt ?X" using delta_hedging_self_financing .
  show "stock_portfolio Mkt (delta_hedging N der matur)" unfolding delta_hedging_def self_fin_delta_pf_def
    stock_portfolio_def portfolio_def using stocks delta_pf_support
    by (smt Un_insert_right delta_pf_portfolio insert_commute portfolio_def self_finance_def
        self_finance_portfolio single_comp_support subset_insertI2 subset_singleton_iff
        sum_support_set sup_bot.right_neutral)
  show "AEeq M (cls_val_process Mkt (delta_hedging N der matur) matur) der"
    using delta_hedging_same_cash_flow assms by simp
qed

definition (in disc_equity_market) complete_market where
"complete_market  (matur.  der borel_measurable (F matur). (p. replicating_portfolio p der matur))"

lemma (in CRR_market_viable) CRR_market_complete:
  shows "complete_market" unfolding complete_market_def
proof (intro allI impI)
  fix matur::nat
  show " der  borel_measurable (G matur). (p. replicating_portfolio p der matur)"
  proof
    fix der::"bool streamreal"
    assume "der  borel_measurable (G matur)"
    define N where "N = bernoulli_stream ((1 + r - d) / (u - d))"
    hence "replicating_portfolio (delta_hedging N der matur) der matur" using delta_hedging_replicating
      der  borel_measurable (G matur) by simp
    thus "pf. replicating_portfolio pf der matur" by auto
  qed
qed


lemma subalgebras_filtration:
  assumes "filtration M F"
and "t. subalgebra (F t) (G t)"
and " s t. s  t  subalgebra (G t) (G s)"
shows "filtration M G" unfolding filtration_def
proof (intro conjI allI impI)
  {
    fix t
    have "subalgebra (F t) (G t)" using assms by simp
    moreover have "subalgebra M (F t)" using assms unfolding filtration_def by simp
    ultimately show "subalgebra M (G t)" by (metis subalgebra_def subsetCE subsetI)
  }
  {
    fix s t::'b
    assume "s  t"
    thus "subalgebra (G t) (G s)" using assms by simp
  }
qed



lemma subfilt_filt_equiv:
  assumes "filt_equiv F M N"
and " t. subalgebra (F t) (G t)"
and " s t. s  t  subalgebra (G t) (G s)"
shows "filt_equiv G M N" unfolding filt_equiv_def
proof (intro conjI)
  show "sets M = sets N" using assms unfolding filt_equiv_def by simp
  show "filtration M G" using assms subalgebras_filtration[of M F G] unfolding filt_equiv_def by simp
  show "t A. A  sets (G t)  (emeasure M A = 0) = (emeasure N A = 0)"
  proof (intro allI ballI impI)
    fix t
    fix A
    assume "A sets (G t)"
    hence "A  sets (F t)" using assms unfolding subalgebra_def by auto
    thus "(emeasure M A = 0) = (emeasure N A = 0)" using assms unfolding filt_equiv_def by simp
  qed
qed

lemma (in CRR_market_viable) CRR_market_fair_price:
  assumes "pyf borel_measurable (G matur)"
  shows "fair_price Mkt
    ( w range (pseudo_proj_True matur). (prod (prob_component ((1 + r - d) / (u - d)) w) {0..<matur}) *
      ((discounted_value r (λm. pyf) matur) w))
    pyf matur"
proof -
  define dpf where "dpf = (discounted_value r (λm. pyf) matur)"
  define q where "q = (1 + r - d) / (u - d)"
  have "pf. replicating_portfolio pf pyf matur" using CRR_market_complete assms unfolding complete_market_def by simp
  from this obtain pf where "replicating_portfolio pf pyf matur" by auto note pfprop = this
  define N where "N = bernoulli_stream ((1 + r - d) / (u - d))"
  have "fair_price Mkt (integralL N dpf) pyf matur" unfolding dpf_def
  proof (rule replicating_expectation_finite)
    show "risk_neutral_prob N" using assms risk_neutral_iff
      using CRR_viable gt_param lt_param N_def by blast
    have "filt_equiv nat_filtration M N"  using bernoulli_stream_equiv[of N "(1+r-d)/(u-d)"]
        assms gt_param lt_param CRR_viable psgt pslt N_def by simp
    thus "filt_equiv G M N" using subfilt_filt_equiv
      using Filtration.filtration_def filtration geom_rand_walk_borel_adapted
        stoch_proc_subalg_nat_filt stock_filtration by blast
    show "pyf  borel_measurable (G matur)" using assms by simp
    show "viable_market Mkt" using CRR_viable by simp
    have "infinite_cts_filtration p M nat_filtration" using bernoulli_nat_filtration[of M p] bernoulli psgt pslt
      by simp
    thus "sets (G 0) = {{}, space M}" using stock_filtration
      infinite_cts_filtration.stoch_proc_filt_triv_init[of p M nat_filtration geom_proc]
      geom_rand_walk_borel_adapted bot_nat_def unfolding init_triv_filt_def by simp
    show "replicating_portfolio pf pyf matur" using pfprop .
    show "n. assetsupport_set pf. finite (prices Mkt asset n ` space M)"
    proof (intro allI ballI)
      fix n
      fix asset
      assume "asset  support_set pf"
      hence "prices Mkt asset n  borel_measurable (G n)" using readable pfprop
        unfolding  replicating_portfolio_def stock_portfolio_def adapt_stoch_proc_def by auto
      hence "prices Mkt asset n  borel_measurable (nat_filtration n)" using stock_filtration
        stoch_proc_subalg_nat_filt geom_rand_walk_borel_adapted
        measurable_from_subalg[of "nat_filtration n" "G n" "prices Mkt asset n" borel]
        unfolding adapt_stoch_proc_def by auto
      thus "finite (prices Mkt asset n ` space M)" using nat_filtration_vimage_finite[of "prices Mkt asset n"] by simp
    qed
    show "n. assetsupport_set pf. finite (pf asset n ` space M)"
    proof (intro allI ballI)
      fix n
      fix asset
      assume "asset  support_set pf"
      hence "pf asset n  borel_measurable (G n)" using pfprop predict_imp_adapt[of "pf asset"]
        unfolding replicating_portfolio_def trading_strategy_def adapt_stoch_proc_def by auto
      hence "pf asset n  borel_measurable (nat_filtration n)" using stock_filtration
        stoch_proc_subalg_nat_filt geom_rand_walk_borel_adapted
        measurable_from_subalg[of "nat_filtration n" "G n" "pf asset n" borel]
        unfolding adapt_stoch_proc_def by auto
      thus "finite (pf asset n ` space M)" using nat_filtration_vimage_finite[of "pf asset n"] by simp
    qed
  qed
  moreover have "integralL N dpf =
    ( w range (pseudo_proj_True matur). (prod (prob_component q w) {0..<matur}) * (dpf w))"
  proof (rule infinite_cts_filtration.expect_prob_comp)
    show "infinite_cts_filtration q N nat_filtration" using  assms  pslt psgt
        bernoulli_nat_filtration unfolding q_def using gt_param lt_param CRR_viable N_def by auto
    have "dpf  borel_measurable (G matur)" using assms discounted_measurable[of pyf "G matur"]
      unfolding dpf_def by simp
    thus "dpf  borel_measurable (nat_filtration matur)" using stock_filtration
        stoch_proc_subalg_nat_filt geom_rand_walk_borel_adapted
        measurable_from_subalg[of "nat_filtration matur" "G matur" dpf]
      unfolding adapt_stoch_proc_def by auto
  qed
  ultimately show ?thesis unfolding dpf_def q_def by simp
qed

end

Theory Option_Price_Examples

theory Option_Price_Examples imports CRR_Model

begin

text ‹ This file contains pricing results for four options in the Cox-Ross-Rubinstein model. The first section contains results
relating some functions to the more abstract counterparts that were used to prove fairness and completeness results. The second
section contains the pricing results for a few options; some path-dependent and others not. ›

section  ‹ Effective computation definitions and results ›

subsection ‹ Generation of lists of boolean elements ›

text ‹ The function gener-bool-list permits to generate lists of boolean elements. It is used to generate a list representative
of the range of boolean streams by the function pseudo-proj-True. ›

fun gener_bool_list where
"gener_bool_list 0 = {[]}"
| "gener_bool_list (Suc n) = {True # w| w. w gener_bool_list n}  {False # w| w. w gener_bool_list n}"

lemma gener_bool_list_elem_length:
  shows "x. x gener_bool_list n  length x = n"
proof (induction n)
  case 0
  fix x
  assume "x gener_bool_list 0"
  hence "x = []" by simp
  thus "length x = 0" by simp
next
  case (Suc n)
  fix x
  assume "x gener_bool_list (Suc n)"
  hence mem: "x {True # w| w. w gener_bool_list n}  {False # w| w. w gener_bool_list n}" by simp
  show "length x = Suc n"
  proof (cases "x {True # w| w. w gener_bool_list n}")
    case True
    hence "w  gener_bool_list n. x = True # w" by auto
    from this obtain w where "w gener_bool_list n" and "x = True # w" by auto
    hence "length w = n" using Suc by simp
    thus "length x = Suc n" using x = True # w by simp
  next
    case False
    hence "x {False # w| w. w gener_bool_list n}" using mem by auto
    hence "w  gener_bool_list n. x = False # w" by auto
    from this obtain w where "w gener_bool_list n" and "x = False # w" by auto
    hence "length w = n" using Suc by simp
    thus "length x = Suc n" using x = False # w by simp
  qed
qed

lemma (in infinite_coin_toss_space) stake_gener_bool_list:
  shows "stake n`streams (UNIV::bool set) = gener_bool_list n"
proof (induction n)
  case 0
  thus "stake 0 ` streams UNIV = gener_bool_list 0" by auto
next
  case (Suc n)
  show "stake (Suc n) ` streams UNIV = gener_bool_list (Suc n)"
  proof -
    have "stake (Suc n)`streams (UNIV::bool set) = {s#w| s w. s UNIV  w (stake n `(streams UNIV))}"
      by (metis (no_types) UNIV_bool UNIV_not_empty stake_finite_universe_induct[of UNIV n] finite.emptyI finite_insert)
    also have "... = {s#w| s w. s {True, False}  w (stake n `(streams UNIV))}" by simp
    also have "... = {s#w| s w. s {True, False}  w gener_bool_list n}" using Suc by simp
    also have "... = {s#w| s w. s {True}  w gener_bool_list n}  {s#w| s w. s { False}  w gener_bool_list n}" by auto
    also have "... = {True # w | w. w gener_bool_list n}  {False#w | w. w gener_bool_list n}" by auto
    also have "... = gener_bool_list (Suc n)" by simp
    finally show ?thesis .
  qed
qed

lemma (in infinite_coin_toss_space) pseudo_range_stake:
  assumes "w. f w = g (stake n w)"
  shows "( w range (pseudo_proj_True n). f w) = ( y (gener_bool_list n). g y)"
proof (rule sum.reindex_cong)
  show "inj_on (λ l. shift l (sconst True)) (gener_bool_list n)" 
  proof
    fix x y
    assume "x gener_bool_list n"
    and "y gener_bool_list n"
    and "x @- sconst True = y @- sconst True"
    have "length x = n" using gener_bool_list_elem_length x gener_bool_list n by simp
    have "length y = n" using gener_bool_list_elem_length y gener_bool_list n by simp
    show "x = y"
    proof -
      have " i < n. nth x i = nth y i"
      proof (intro allI impI)
        fix i
        assume "i < n"   
        have xi: "snth (x @- sconst True) i = nth x i" using i < n ‹length x = n by simp
        have yi: "snth (y @- sconst True) i = nth y i" using i < n ‹length y = n by simp
        have "snth (x @- sconst True) i = snth (y @- sconst True) i"  using x @- sconst True = y @- sconst True›
          by simp
        thus "nth x i = nth y i" using xi yi by simp
      qed
      thus ?thesis using ‹length x = n ‹length y = n by (simp add: list_eq_iff_nth_eq)
    qed
  qed        
  have  "range (pseudo_proj_True n) = {shift l (sconst True)|l. l(stake n `streams (UNIV::bool set))} " 
    unfolding pseudo_proj_True_def by auto
  also have "... = {shift l (sconst True)|l. l(gener_bool_list n)} " using stake_gener_bool_list by simp
  also have "... = (λl. l @- sconst True) ` gener_bool_list n" by auto
  finally show "range (pseudo_proj_True n) = (λl. l @- sconst True) ` gener_bool_list n" .
  fix x
  assume "x gener_bool_list n"
  have "length x = n" using gener_bool_list_elem_length x gener_bool_list n by simp
  have "f (x @- sconst True) = g (stake n (x @- sconst True))" using assms by simp
  also have "... = g x" using ‹length x = n by (simp add: stake_shift)
  finally show "f (x @- sconst True) = g x" .
qed


subsection ‹ Probability components for lists ›

fun lprob_comp where
"lprob_comp (p::real) [] = 1"
| "lprob_comp p (x # xs) = (if x then p else (1-p)) * lprob_comp p xs"


lemma lprob_comp_last:
  shows "lprob_comp p (xs @ [x]) = (lprob_comp p xs) * (if x then p else (1 - p))"
proof (induction xs)
  case Nil
  have "lprob_comp p (Nil @ [x]) = lprob_comp p [x]" by simp
  also have "... = (if x then p else (1 - p))" by simp
  also have "... = (lprob_comp p Nil) * (if x then p else (1 - p))" by simp
  finally show "lprob_comp p (Nil @ [x]) = (lprob_comp p Nil) * (if x then p else (1 - p))" .
next
  case (Cons a xs)
  have "lprob_comp p ((Cons a xs) @ [x]) = (if a then p else (1 - p)) * lprob_comp p (xs @ [x])" by simp
  also have "... = (if a then p else (1 - p)) * (lprob_comp p xs) * (if x then p else (1-p))" using Cons by simp
  also have "... = lprob_comp p (Cons a xs) * (if x then p else (1-p))" by simp
  finally show "lprob_comp p ((Cons a xs) @ [x]) = lprob_comp p (Cons a xs) * (if x then p else (1-p))" .
qed

lemma (in infinite_coin_toss_space) lprob_comp_stake:
  shows "(prod (prob_component pr w) {0..<matur}) = lprob_comp pr (stake matur w)"
proof (induction matur)
  case 0
  have "prod (prob_component pr w) {0..<0} = 1" by simp
  also have "... = lprob_comp pr []" by simp
  also have "... = lprob_comp pr (stake 0 w)" by simp
  finally show "prod (prob_component pr w) {0..<0} = lprob_comp pr (stake 0 w)" .
next
  case (Suc n)
  have "prod (prob_component pr w) {0..<Suc n} = prod (prob_component pr w) {0..< n} *
    (prob_component pr w n)" using prod.atLeast0_lessThan_Suc by blast 
  also have "... = lprob_comp pr (stake n w) * (prob_component pr w n)" using Suc by simp
  also have "... = lprob_comp pr (stake n w) * (if (snth w n) then pr else 1-pr)" by (simp add: prob_component_def)
  also have "... = lprob_comp pr ((stake n w) @ [snth w n])" by (simp add: lprob_comp_last)
  also have "... = lprob_comp pr (stake (Suc n) w)" by (metis Stream.stake_Suc) 
  finally show "prod (prob_component pr w) {0..<Suc n} = lprob_comp pr (stake (Suc n) w)" .
qed

subsection ‹ Geometric process applied to lists ›

fun lrev_geom where
"lrev_geom u d v [] = v"
| "lrev_geom u d v (x#xs) = (if x then u else d) * lrev_geom u d v xs"

fun lgeom_proc where "lgeom_proc u d v l = lrev_geom u d v (rev l)"

lemma (in infinite_coin_toss_space) geom_lgeom:
  shows "geom_rand_walk u d v n w = lgeom_proc u d v (stake n w)"
proof (induction n)
  case 0
  have "geom_rand_walk u d v 0 w = v" by simp
  also have "... = lrev_geom u d v []" by simp
  also have "... = lrev_geom u d v (rev (stake 0 w))" by simp
  also have "... = lgeom_proc u d v (stake 0 w)" by simp
  finally show "geom_rand_walk u d v 0 w = lgeom_proc u d v (stake 0 w)" .
next
  case (Suc n)
  have "snth w n = nth (stake (Suc n) w) n" using stake_nth by blast
  have "(stake n w) @ [nth (stake (Suc n) w) n] = stake (Suc n) w"
    by (metis Stream.stake_Suc lessI stake_nth)
  have "geom_rand_walk u d v (Suc n) w = ((λTrue  u | False  d) (snth w n)) * geom_rand_walk u d v n w" by simp
  also have "... = (if (snth w n) then u else d) * geom_rand_walk u d v n w" by simp
  also have "... = (if (snth w n) then u else d) * lgeom_proc u d v (stake n w)" using Suc by simp
  also have "... = (if (snth w n) then u else d) * lrev_geom u d v (rev (stake n w))" by simp
  also have "... = lrev_geom u d v ((snth w n) # (rev (stake n w)))" by simp
  also have "... = lrev_geom u d v (rev ((stake n w) @ [snth w n]))" by simp 
  also have "... = lrev_geom u d v (rev ((stake n w) @ [nth (stake (Suc n) w) n]))" 
    using ‹snth w n = nth (stake (Suc n) w) n by simp
  also have "... = lrev_geom u d v (rev (stake (Suc n) w))" 
    using (stake n w) @ [nth (stake (Suc n) w) n] = stake (Suc n) w by simp
  also have "... = lgeom_proc u d v (stake (Suc n) w)" by simp
  finally show "geom_rand_walk u d v (Suc n) w = lgeom_proc u d v (stake (Suc n) w)" .
qed

lemma lgeom_proc_take:
  assumes "i  n"
  shows "lgeom_proc u d init (stake i w) = lgeom_proc u d init (take i (stake n w))"
proof -
  have "stake i w = take i (stake n w)" using assms by (simp add: min.absorb1 take_stake)
  thus ?thesis by simp
qed

subsection ‹ Effective computation of discounted values ›


fun det_discount where
"det_discount (r::real) 0 = 1"
| "det_discount r (Suc n) = (inverse (1+r)) * (det_discount r n)"


lemma det_discounted:
  shows "discounted_value r X n w = (det_discount r n) * (X n w)" unfolding discounted_value_def discount_factor_def
proof (induction n arbitrary: X)
  case 0
  have "inverse (disc_rfr_proc r 0 w) * X 0 w =  X 0 w" by simp
  also have "... = (det_discount r 0) * (X 0 w)" by simp
  finally show "inverse (disc_rfr_proc r 0 w) * X 0 w = (det_discount r 0) * (X 0 w)" .
next
  case (Suc n)
  have "inverse (disc_rfr_proc r (Suc n) w) * X (Suc n) w = 
    inverse ((1+r) * (disc_rfr_proc r) n w) * X (Suc n) w" by simp
  also have "... = (inverse (1+r)) * inverse ((disc_rfr_proc r) n w) * X (Suc n) w" by simp
  also have "... = (inverse (1+r)) * (det_discount r n) * X (Suc n) w" using Suc[of "λn. X (Suc n)"] by auto
  also have "... = (det_discount r (Suc n)) * X (Suc n) w" by simp
  finally show "inverse (disc_rfr_proc r (Suc n) w) * X (Suc n) w = (det_discount r (Suc n)) * X (Suc n) w" .
qed

section ‹Pricing results on options ›

subsection ‹ Call option ›

text ‹ A call option is parameterized by a strike K and maturity T. If S denotes the price of the (unique) risky asset at 
time T, then the option pays max(S - K, 0) at that time.›

definition (in CRR_market) call_option where
"call_option (T::nat) (K::real) = (λ w. max (prices Mkt stk T w - K) 0)"

lemma (in CRR_market) call_borel:
  shows "call_option T K  borel_measurable (G T)" unfolding call_option_def
proof (rule borel_measurable_max)
  show "(λx. 0)  borel_measurable (G T)" by simp
  show "(λx. prices Mkt stk T x - K)  borel_measurable (G T)"
  proof (rule borel_measurable_diff)
    show "prices Mkt stk T  borel_measurable (G T)" 
      by (metis  adapt_stoch_proc_def stock_price_borel_measurable)
  qed simp
qed

lemma (in CRR_market_viable) call_option_lgeom:
  shows "call_option T K w = max ((lgeom_proc u d init (stake T w)) - K) 0"
  using geom_lgeom stk_price geometric_process unfolding call_option_def by simp

lemma (in CRR_market_viable) disc_call_option_lgeom:
  shows "(discounted_value r (λm. (call_option T K)) T w) = 
    (det_discount r T) * (max ((lgeom_proc u d init (stake T w)) - K) 0)"
    using det_discounted[of r "λm. call_option T K" T w] call_option_lgeom[of T K w] by simp

lemma (in CRR_market_viable) call_effect_compute:
shows "( w range (pseudo_proj_True matur). (prod (prob_component pr w) {0..<matur}) * 
      (discounted_value r (λm. (call_option matur K)) matur w)) =
      ( y (gener_bool_list matur). lprob_comp pr y * (det_discount r matur) * 
      (max ((lgeom_proc u d init (take matur y)) - K) 0))" 
proof (rule pseudo_range_stake)
  fix w
  have "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. call_option matur K) matur w =
    lprob_comp pr (stake matur w) * discounted_value r (λm. call_option matur K) matur w"
    using lprob_comp_stake by simp 
  also have "... = lprob_comp pr (stake matur w) *
    (det_discount r matur) * (max ((lgeom_proc u d init (take matur (stake matur w))) - K) 0)" 
    using disc_call_option_lgeom[of matur K] by simp
  finally show "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. call_option matur K) matur w =
    lprob_comp pr (stake matur w) *
    (det_discount r matur) * (max ((lgeom_proc u d init (take matur (stake matur w))) - K) 0)" .
qed

fun call_price where
"call_price u d init r matur K = ( y (gener_bool_list matur). lprob_comp ((1 + r - d) / (u - d)) y * (det_discount r matur) * 
      (max ((lgeom_proc u d init (take matur (take matur y))) - K) 0))"

text ‹ Evaluating the function above returns the fair price of a call option. ›

lemma (in CRR_market_viable) call_price:
  shows "fair_price Mkt 
    (call_price u d init r matur K) 
    (call_option matur K) matur"
proof -
  have "fair_price Mkt 
    ( w range (pseudo_proj_True matur). (prod (prob_component ((1 + r - d) / (u - d)) w) {0..<matur}) * 
      (discounted_value r (λm. (call_option matur K)) matur w)) 
    (call_option matur K) matur"
    by (rule CRR_market_fair_price, rule call_borel)
  thus ?thesis using call_effect_compute by simp
qed

subsection ‹ Put option ›

text ‹ A put option is also parameterized by a strike K and maturity T. If S denotes the price of the (unique) risky asset at 
time T, then the option pays max(K - S, 0) at that time. ›

definition (in CRR_market) put_option where
"put_option (T::nat) (K::real) = (λ w. max (K - prices Mkt stk T w) 0)"

lemma (in CRR_market) put_borel:
  shows "put_option T K  borel_measurable (G T)" unfolding put_option_def
proof (rule borel_measurable_max)
  show "(λx. 0)  borel_measurable (G T)" by simp
  show "(λx. K - prices Mkt stk T x)  borel_measurable (G T)"
  proof (rule borel_measurable_diff)
    show "prices Mkt stk T  borel_measurable (G T)" 
      by (metis  adapt_stoch_proc_def stock_price_borel_measurable)
  qed simp
qed

lemma (in CRR_market_viable) put_option_lgeom:
  shows "put_option T K w = max (K - (lgeom_proc u d init (stake T w))) 0"
  using geom_lgeom stk_price geometric_process unfolding put_option_def by simp

lemma (in CRR_market_viable) disc_put_option_lgeom:
  shows "(discounted_value r (λm. (put_option T K)) T w) = 
    (det_discount r T) * (max (K - (lgeom_proc u d init (stake T w))) 0)"
    using det_discounted[of r "λm. put_option T K" T w] put_option_lgeom[of T K w] by simp

lemma (in CRR_market_viable) put_effect_compute:
shows "( w range (pseudo_proj_True matur). (prod (prob_component pr w) {0..<matur}) * 
      (discounted_value r (λm. (put_option matur K)) matur w)) =
      ( y (gener_bool_list matur). lprob_comp pr y * (det_discount r matur) * 
      (max (K - (lgeom_proc u d init (take matur y))) 0))" 
proof (rule pseudo_range_stake)
  fix w
  have "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. put_option matur K) matur w =
    lprob_comp pr (stake matur w) * discounted_value r (λm. put_option matur K) matur w"
    using lprob_comp_stake by simp 
  also have "... = lprob_comp pr (stake matur w) *
    (det_discount r matur) * (max (K - (lgeom_proc u d init (take matur (stake matur w)))) 0)" 
    using disc_put_option_lgeom[of matur K] by simp
  finally show "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. put_option matur K) matur w =
    lprob_comp pr (stake matur w) *
    (det_discount r matur) * (max (K - (lgeom_proc u d init (take matur (stake matur w)))) 0)" .
qed

fun put_price where
"put_price u d init r matur K = ( y (gener_bool_list matur). lprob_comp ((1 + r - d) / (u - d)) y * (det_discount r matur) * 
      (max (K - (lgeom_proc u d init (take matur (take matur y)))) 0))"

text ‹ Evaluating the function above returns the fair price of a put option. ›

lemma (in CRR_market_viable) put_price:
  shows "fair_price Mkt 
    (put_price u d init r matur K) 
    (put_option matur K) matur"
proof -
  have "fair_price Mkt 
    ( w range (pseudo_proj_True matur). (prod (prob_component ((1 + r - d) / (u - d)) w) {0..<matur}) * 
      (discounted_value r (λm. (put_option matur K)) matur w)) 
    (put_option matur K) matur"
    by (rule CRR_market_fair_price, rule put_borel)
  thus ?thesis using put_effect_compute by simp
qed


subsection ‹ Lookback option ›

text ‹ A lookback option is parameterized by a maturity T. If Sn denotes the price of the (unique) risky asset at 
time n, then the option pays max(Sn. 0 <= n <= T) - ST at that time. ›

definition (in CRR_market) lbk_option where
"lbk_option (T::nat) = (λ w. Max ((λi. (prices Mkt stk) i w)`{0 .. T}) - (prices Mkt stk T w))"

lemma borel_measurable_Max_finite:
  fixes f::"'a  'b  'c::{second_countable_topology, linorder_topology}"
  assumes "0 < (n::nat)"
shows "A. card A = n  a  A. f a  borel_measurable M  (λw. Max ((λa. f a w)`A))  borel_measurable M" using assms
proof (induct n)
  case 0
  show "A. card A = 0  aA. f a  borel_measurable M  (0::nat) < 0  (λw. Max ((λa. f a w) ` A))  borel_measurable M" 
  proof -
    fix A::"'a set"
    assume "card A = 0" and  "aA. f a  borel_measurable M" and "(0::nat) < 0" 
    thus "(λw. Max ((λa. f a w) ` A))  borel_measurable M" by simp
  qed
next
  case Suc
  show "n A. (A. card A = n 
                 aA. f a  borel_measurable M  0 < n  (λw. Max ((λa. f a w) ` A))  borel_measurable M) 
           card A = Suc n 
           aA. f a  borel_measurable M  0 < Suc n  (λw. Max ((λa. f a w) ` A))  borel_measurable M"
  proof -
    fix n
    fix A::"'a set"
    assume ameas: "(A. card A = n 
                 aA. f a  borel_measurable M  0 < n  (λw. Max ((λa. f a w) ` A))  borel_measurable M)"
    and "card A = Suc n"
    and "aA. f a  borel_measurable M"
    and "0 < Suc n"
    from ‹card A = Suc n have aprop: "A {}  finite A" using card_eq_0_iff[of A] by simp
    hence "x. x A" by auto
    from this obtain a where "a A" by auto
    hence "Suc (card (A - {a})) = Suc n" using aprop card_Suc_Diff1[of A] ‹card A = Suc n by auto  
    hence "card (A - {a}) = n" by simp
    show "(λw. Max ((λa. f a w) ` A))  borel_measurable M"
    proof (cases "n = 0")
      case False
      hence "0 < n" by simp
      moreover have "aA - {a}. f a  borel_measurable M" using aA. f a  borel_measurable M by simp
      ultimately have "(λw. Max ((λa. f a w) ` (A-{a})))  borel_measurable M" using ‹card (A - {a}) = n
        ameas[of "A - {a}"] by simp
      moreover have "f a  borel_measurable M" using aA. f a  borel_measurable M aA by simp
      ultimately have "(λ w. max (f a w) (Max ((λa. f a w) ` (A-{a}))))  borel_measurable M"
        using borel_measurable_max by simp
      moreover have "w. max (f a w) (Max ((λa. f a w) ` (A-{a}))) = Max ((λa. f a w) `A)"
      proof -
        fix w
        define FA where "FA = ((λa. f a w) ` (A-{a}))"
        have "finite FA" unfolding FA_def using aprop by simp 
        have "A - {a}  {}" using aprop False ‹card (A - {a}) = n card_eq_0_iff[of "A - {a}"] by simp 
        hence "FA  {}" unfolding FA_def by simp
        have "max (f a w) (Max FA) = Max (insert (f a w) FA)" using ‹finite FA FA  {} by simp
        hence  "max (f a w) (Max ((λa. f a w) ` (A-{a}))) = Max (insert (f a w) ((λa. f a w) `(A-{a})))"
          unfolding FA_def by simp
        also have "... = Max ((λa. f a w) `A)"
        proof -
          have "insert (f a w) ((λa. f a w) `(A-{a})) = (λa. f a w) `(insert a (A - {a}))"
            by auto
          also have "... = ((λa. f a w) `A)" using a  A by blast
          finally have "insert (f a w) ((λa. f a w) `(A-{a})) = ((λa. f a w) `A)" .
          thus ?thesis by simp 
        qed
        finally show "max (f a w) (Max ((λa. f a w) ` (A-{a}))) = Max ((λa. f a w) `A)" .
      qed
      ultimately show "(λw. Max ((λa. f a w) `A))  borel_measurable M" by simp
    next
      case True
      hence "A - {a} = {}" using aprop card_eq_0_iff[of "A - {a}"] ‹card (A - {a}) = n by simp
      hence "{a} = insert a (A - {a})" by simp
      also have "... = A" using a A by blast
      finally have "{a} = A" .
      hence "w. (λa. f a w) `A = {f a w}" by auto
      hence "w. Max ((λa. f a w) `A) = Max {f a w}" by simp
      hence "w. Max ((λa. f a w) `A) = f a w" by simp
      hence "(λw. Max ((λa. f a w) `A)) = f a" by simp
      thus "(λw. Max ((λa. f a w) `A))  borel_measurable M" using aA. f a  borel_measurable M 
        a A by simp
    qed
  qed
qed


lemma (in CRR_market) lbk_borel:
  shows "lbk_option T  borel_measurable (G T)" unfolding lbk_option_def
proof (rule borel_measurable_diff)
  show "(λx. Max ((λi. prices Mkt stk i x) ` {0..T}))  borel_measurable (G T)"
  proof (rule borel_measurable_Max_finite)
    show "card {0..T} = Suc T" by simp
    show "0 < Suc T" by simp
    show "i{0..T}. prices Mkt stk i  borel_measurable (G T)"
    proof
      fix i
      assume "i {0..T}"
      show "prices Mkt stk i  borel_measurable (G T)"
        by (metis i  {0..T} adapt_stoch_proc_def atLeastAtMost_iff increasing_measurable_info 
            stock_price_borel_measurable)
    qed
  qed
  show "prices Mkt stk T  borel_measurable (G T)" by (metis  adapt_stoch_proc_def stock_price_borel_measurable)
qed

lemma (in CRR_market_viable) lbk_option_lgeom:
  shows "lbk_option T w = Max ((λi. (lgeom_proc u d init (stake i w)))`{0 .. T}) - (lgeom_proc u d init (stake T w))"
  using geom_lgeom stk_price geometric_process unfolding lbk_option_def by simp


lemma (in CRR_market_viable) disc_lbk_option_lgeom:
  shows "(discounted_value r (λm. (lbk_option T)) T w) = 
    (det_discount r T) * (Max ((λi. (lgeom_proc u d init (take i (stake T w))))`{0 .. T}) - (lgeom_proc u d init (stake T w)))"
    using det_discounted[of r "λm. lbk_option T" T w] lbk_option_lgeom[of T w] lgeom_proc_take
    by (metis (no_types, lifting) atLeastAtMost_iff image_cong) 

lemma (in CRR_market_viable) lbk_effect_compute:
shows "( w range (pseudo_proj_True matur). (prod (prob_component pr w) {0..<matur}) * 
      (discounted_value r (λm. (lbk_option matur)) matur w)) =
      ( y (gener_bool_list matur). lprob_comp pr y * (det_discount r matur) * 
      (Max ((λi. (lgeom_proc u d init (take i y)))`{0 .. matur}) - (lgeom_proc u d init y)))" 
proof (rule pseudo_range_stake)
  fix w
  have "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. lbk_option matur) matur w =
    lprob_comp pr (stake matur w) * discounted_value r (λm. lbk_option matur) matur w"
    using lprob_comp_stake by simp 
  also have "... = lprob_comp pr (stake matur w) *
    (det_discount r matur) * (Max ((λi. (lgeom_proc u d init (take i (stake matur w))))`{0 .. matur}) - 
      (lgeom_proc u d init (stake matur w)))" using disc_lbk_option_lgeom by simp
  finally show "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. lbk_option matur) matur w =
    lprob_comp pr (stake matur w) *
    (det_discount r matur) * (Max ((λi. (lgeom_proc u d init (take i (stake matur w))))`{0 .. matur}) - 
      (lgeom_proc u d init (stake matur w)))" .
qed

fun lbk_price where
"lbk_price u d init r matur = ( y (gener_bool_list matur). lprob_comp ((1 + r - d) / (u - d)) y * (det_discount r matur) * 
      (Max ((λi. (lgeom_proc u d init (take i y)))`{0 .. matur}) - (lgeom_proc u d init y)))"


text ‹ Evaluating the function above returns the fair price of a lookback option. ›

lemma (in CRR_market_viable) lbk_price:
  shows "fair_price Mkt 
    (lbk_price u d init r matur) 
    (lbk_option matur) matur"
proof -
  have "fair_price Mkt 
    ( w range (pseudo_proj_True matur). (prod (prob_component ((1 + r - d) / (u - d)) w) {0..<matur}) * 
      (discounted_value r (λm. (lbk_option matur)) matur w)) 
    (lbk_option matur) matur"
    by (rule CRR_market_fair_price, rule lbk_borel)
  thus ?thesis using lbk_effect_compute by simp
qed

value "lbk_price 1.2 0.8 10 0.03 2"

subsection ‹ Asian option ›

text ‹ An asian option is parameterized by a maturity T. This option pays the average price of the 
risky asset at time T. ›

definition (in CRR_market) asian_option where
"asian_option (T::nat) = (λ w. ( i {1.. T}. prices Mkt stk i w)/T)"

lemma (in CRR_market) asian_borel:
  shows "asian_option T  borel_measurable (G T)" unfolding asian_option_def
proof -
  have "(λ w. ( i {1.. T}. prices Mkt stk i w))  borel_measurable (G T)"
  proof (rule borel_measurable_sum)
    fix i
    assume "i {1..T}"
    show "prices Mkt stk i  borel_measurable (G T)" 
      by (metis i  {1..T} adapt_stoch_proc_def atLeastAtMost_iff increasing_measurable_info 
            stock_price_borel_measurable)
  qed
  from this show "(λw. (i = 1..T. prices Mkt stk i w) / real T)  borel_measurable (G T)" by simp
qed


lemma (in CRR_market_viable) asian_option_lgeom:
  shows "asian_option T w = ( i {1.. T}. lgeom_proc u d init (stake i w))/ T"
  using geom_lgeom stk_price geometric_process unfolding asian_option_def by simp

lemma (in CRR_market_viable) disc_asian_option_lgeom:
  shows "(discounted_value r (λm. (asian_option T)) T w) = 
    (det_discount r T) * ( i {1.. T}. lgeom_proc u d init (take i (stake T w)))/ T"
proof -
  have " i {1..T}. lgeom_proc u d init (stake i w) = lgeom_proc u d init (take i (stake T w))"
    using lgeom_proc_take by auto
  hence "( i {1.. T}. lgeom_proc u d init (stake i w)) = 
    ( i {1.. T}. lgeom_proc u d init (take i (stake T w)))" by auto
  thus ?thesis
    using det_discounted[of r "λm. asian_option T" T w] asian_option_lgeom[of T w] by auto
qed

lemma (in CRR_market_viable) asian_effect_compute:
shows "( w range (pseudo_proj_True matur). (prod (prob_component pr w) {0..<matur}) * 
      (discounted_value r (λm. (asian_option matur)) matur w)) =
      ( y (gener_bool_list matur). lprob_comp pr y * (det_discount r matur) * 
      ( i {1.. matur}. lgeom_proc u d init (take i y))/ matur)" 
proof (rule pseudo_range_stake)
  fix w
  have "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. asian_option matur) matur w =
    lprob_comp pr (stake matur w) * discounted_value r (λm. asian_option matur) matur w"
    using lprob_comp_stake by simp 
  also have "... = lprob_comp pr (stake matur w) *
    (det_discount r matur) * ( i {1.. matur}. lgeom_proc u d init (take i (stake matur w)))/ matur" 
    using disc_asian_option_lgeom[of matur w] by simp
  finally show "prod (prob_component pr w) {0..<matur} * discounted_value r (λm. asian_option matur) matur w =
    lprob_comp pr (stake matur w) *
    (det_discount r matur) * ( i {1.. matur}. lgeom_proc u d init (take i (stake matur w)))/ matur" .
qed

fun asian_price where
"asian_price u d init r matur = ( y (gener_bool_list matur). lprob_comp ((1 + r - d) / (u - d)) y * (det_discount r matur) * 
      ( i {1.. matur}. lgeom_proc u d init (take i y))/ matur)"

text ‹ Evaluating the function above returns the fair price of an asian option. ›

lemma (in CRR_market_viable) asian_price:
  shows "fair_price Mkt 
    (asian_price u d init r matur) 
    (asian_option matur) matur"
proof -
  have "fair_price Mkt 
    ( w range (pseudo_proj_True matur). (prod (prob_component ((1 + r - d) / (u - d)) w) {0..<matur}) * 
      (discounted_value r (λm. (asian_option matur)) matur w)) 
    (asian_option matur) matur"
    by (rule CRR_market_fair_price, rule asian_borel)
  thus ?thesis using asian_effect_compute by simp
qed

end